BGP8D341 ; IHS/CMI/LAB - measure C ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
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^BGP8D34
;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^BGP8D34
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^BGP8D34
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 ;;
BGP8D341 ; IHS/CMI/LAB - measure C ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
TEST ;EP
+1 ;NOW TEST FOR ALL POSSIBLE COMBINATIONS OF HAVING MET INDICATOR
+2 ;1 DTAP AND 3 EACH TET,PER,DIP
+3 ;kill off any dip or tet on same day as a dtap
+4 SET BGPVAL=""
+5 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BGPDIP(X))
IF X'=+X
QUIT
IF $DATA(BGPDTAP(X))
KILL BGPDIP(X)
+6 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BGPDIP(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+7 IF C=1
SET Y=X
QUIT
+8 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BGPDIP(X)
QUIT
+9 SET Y=X
End DoDot:1
+10 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BGPTET(X))
IF X'=+X
QUIT
IF $DATA(BGPDTAP(X))
KILL BGPTET(X)
+11 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BGPTET(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+12 IF C=1
SET Y=X
QUIT
+13 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BGPTET(X)
QUIT
+14 SET Y=X
End DoDot:1
+15 SET BGPDIP=0
SET X=0
FOR
SET X=$ORDER(BGPDIP(X))
IF X'=+X
QUIT
SET BGPDIP=BGPDIP+1
+16 SET BGPTET=0
SET X=0
FOR
SET X=$ORDER(BGPTET(X))
IF X'=+X
QUIT
SET BGPTET=BGPTET+1
+17 IF BGPTET>2
IF BGPDIP>1
IF $ORDER(BGPDTAP(0))
SET BGPBAL=BGPCODE_U_"Dtap & 3 TET & 3 DIP"
QUIT
DTPER ;is there 4 DT and 4 pertussis?
+1 DO RESET^BGP8D34
+2 ;delete ones not 10 days apart
+3 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BGPDT(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+4 IF C=1
SET Y=X
QUIT
+5 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BGPDT(X)
QUIT
+6 SET Y=X
End DoDot:1
+7 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BGPPER(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+8 IF C=1
SET Y=X
QUIT
+9 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BGPPER(X)
QUIT
+10 SET Y=X
End DoDot:1
+11 SET BGPDT=0
SET X=0
FOR
SET X=$ORDER(BGPDT(X))
IF X'=+X
QUIT
SET BGPDT=BGPDT+1
+12 SET BGPPER=0
SET X=0
FOR
SET X=$ORDER(BGPPER(X))
IF X'=+X
QUIT
SET BGPPER=BGPPER+1
+13 IF BGPPER>3
IF BGPDT>3
SET BGPVAL=BGPCODE_U_"3 DT & 3 PER"
QUIT
TDPER ;
+1 DO RESET^BGP8D34
+2 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BGPTD(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+3 IF C=1
SET Y=X
QUIT
+4 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BGPTD(X)
QUIT
+5 SET Y=X
End DoDot:1
+6 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BGPPER(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+7 IF C=1
SET Y=X
QUIT
+8 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BGPPER(X)
QUIT
+9 SET Y=X
End DoDot:1
+10 SET BGPTD=0
SET X=0
FOR
SET X=$ORDER(BGPTD(X))
IF X'=+X
QUIT
SET BGPTD=BGPTD+1
+11 SET BGPPER=0
SET X=0
FOR
SET X=$ORDER(BGPPER(X))
IF X'=+X
QUIT
SET BGPPER=BGPPER+1
+12 IF BGPPER>3
IF BGPTD>3
SET BGPVAL=BGPCODE_U_"3 TD & 3 PER"
QUIT
+13 IF BGPTD>2
IF $ORDER(BGPDTAP(0))
SET BGPVAL=BGPCODE_U_"Dtap & 3 Td"
QUIT
DIPTETPE ;
+1 DO RESET^BGP8D34
+2 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BGPPER(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+3 IF C=1
SET Y=X
QUIT
+4 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BGPPER(X)
QUIT
+5 SET Y=X
End DoDot:1
+6 SET BGPPER=0
SET X=0
FOR
SET X=$ORDER(BGPPER(X))
IF X'=+X
QUIT
SET BGPPER=BGPPER+1
+7 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BGPDIP(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+8 IF C=1
SET Y=X
QUIT
+9 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BGPDIP(X)
QUIT
+10 SET Y=X
End DoDot:1
+11 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BGPTET(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+12 IF C=1
SET Y=X
QUIT
+13 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BGPTET(X)
QUIT
+14 SET Y=X
End DoDot:1
+15 SET BGPDIP=0
SET X=0
FOR
SET X=$ORDER(BGPDIP(X))
IF X'=+X
QUIT
SET BGPDIP=BGPDIP+1
+16 SET BGPTET=0
SET X=0
FOR
SET X=$ORDER(BGPTET(X))
IF X'=+X
QUIT
SET BGPTET=BGPTET+1
+17 IF BGPPER>3
IF BGPDIP>3
IF BGPTET>3
SET BGPVAL=BGPCODE_U_"3 EACH DIP,TET,PER"
QUIT
+18 QUIT
90700 ;;
90721 ;;
90723 ;;
90701 ;;
90711 ;;
90720 ;;
90702 ;;
90718 ;;
90719 ;;
90703 ;;
