Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP7D341

BGP7D341.m

Go to the documentation of this file.
BGP7D341 ; IHS/CMI/LAB - measure C ;
 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
TEST ;EP
 ;NOW TEST FOR ALL POSSIBLE COMBINATIONS OF HAVING MET INDICATOR
 ;1 DTAP AND 3 EACH TET,PER,DIP
 ;kill off any dip or tet on same day as a dtap
 S BGPVAL=""
 S (X,Y)="",C=0 F  S X=$O(BGPDIP(X)) Q:X'=+X  I $D(BGPDTAP(X)) K BGPDIP(X)
 S (X,Y)="",C=0 F  S X=$O(BGPDIP(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPDIP(X) Q
 .S Y=X
 S (X,Y)="",C=0 F  S X=$O(BGPTET(X)) Q:X'=+X  I $D(BGPDTAP(X)) K BGPTET(X)
 S (X,Y)="",C=0 F  S X=$O(BGPTET(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPTET(X) Q
 .S Y=X
 S BGPDIP=0,X=0 F  S X=$O(BGPDIP(X)) Q:X'=+X  S BGPDIP=BGPDIP+1
 S BGPTET=0,X=0 F  S X=$O(BGPTET(X)) Q:X'=+X  S BGPTET=BGPTET+1
 I BGPTET>2,BGPDIP>1,$O(BGPDTAP(0)) S BGPBAL=BGPCODE_U_"Dtap & 3 TET & 3 DIP" Q
DTPER ;is there 4 DT and 4 pertussis?
 D RESET^BGP7D34
 ;delete ones not 10 days apart
 S (X,Y)="",C=0 F  S X=$O(BGPDT(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPDT(X) Q
 .S Y=X
 S (X,Y)="",C=0 F  S X=$O(BGPPER(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPPER(X) Q
 .S Y=X
 S BGPDT=0,X=0 F  S X=$O(BGPDT(X)) Q:X'=+X  S BGPDT=BGPDT+1
 S BGPPER=0,X=0 F  S X=$O(BGPPER(X)) Q:X'=+X  S BGPPER=BGPPER+1
 I BGPPER>3,BGPDT>3 S BGPVAL=BGPCODE_U_"3 DT & 3 PER" Q
TDPER ;
 D RESET^BGP7D34
 S (X,Y)="",C=0 F  S X=$O(BGPTD(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPTD(X) Q
 .S Y=X
 S (X,Y)="",C=0 F  S X=$O(BGPPER(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPPER(X) Q
 .S Y=X
 S BGPTD=0,X=0 F  S X=$O(BGPTD(X)) Q:X'=+X  S BGPTD=BGPTD+1
 S BGPPER=0,X=0 F  S X=$O(BGPPER(X)) Q:X'=+X  S BGPPER=BGPPER+1
 I BGPPER>3,BGPTD>3 S BGPVAL=BGPCODE_U_"3 TD & 3 PER" Q
 I BGPTD>2,$O(BGPDTAP(0)) S BGPVAL=BGPCODE_U_"Dtap & 3 Td" Q
DIPTETPE ;
 D RESET^BGP7D34
 S (X,Y)="",C=0 F  S X=$O(BGPPER(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPPER(X) Q
 .S Y=X
 S BGPPER=0,X=0 F  S X=$O(BGPPER(X)) Q:X'=+X  S BGPPER=BGPPER+1
 S (X,Y)="",C=0 F  S X=$O(BGPDIP(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPDIP(X) Q
 .S Y=X
 S (X,Y)="",C=0 F  S X=$O(BGPTET(X)) Q:X'=+X  S C=C+1 D
 .I C=1 S Y=X Q
 .I $$FMDIFF^XLFDT(X,Y)<11 K BGPTET(X) Q
 .S Y=X
 S BGPDIP=0,X=0 F  S X=$O(BGPDIP(X)) Q:X'=+X  S BGPDIP=BGPDIP+1
 S BGPTET=0,X=0 F  S X=$O(BGPTET(X)) Q:X'=+X  S BGPTET=BGPTET+1
 I BGPPER>3,BGPDIP>3,BGPTET>3 S BGPVAL=BGPCODE_U_"3 EACH DIP,TET,PER" Q
 Q
90700 ;;
90721 ;;
90723 ;;
90701 ;;
90711 ;;
90720 ;;
90702 ;;
90718 ;;
90719 ;;
90703 ;;