CIMGAGPR ; CMI/TUCSON/LAB - ABERDEEN IMM REPORT ;
;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
;;
;;INPUT VARIABLE
;;
;; CIMDFN = PATIENT DFN
;; CIMDAT = DATE FOR IMMUNIZATION STATUS
;;
;;OUTPUT VARIABLE = UPTODATE
;;
;; UPTODATE = 1 = UPTODATE
;; UPTODATE = 2 = NOT UPTODATE
;;
;;OUTPUT GLOBAL ARRAY
;;
;; ^TMP("CIMGAGPR",$J,"LASTNAME,FIRST NAME",CIMDFN,"NEEDS")="LIST OF IMMUNIZATIONS THE CHILD NEEDS"
;;
KIDS(CIMDFN,CIMDAT) ;EP;DETERMINE CHILDS IMMUNIZATION STATUS
K ^TMP("CIMGAGPR",$J)
;D VARICELL
N CIMIVDA,UPTODATE
S CIMIVDA=0
F S CIMIVDA=$O(^AUPNVIMM("AC",CIMDFN,CIMIVDA)) Q:'CIMIVDA D IMM
S UPTODATE=2
D COUNT
Q UPTODATE
IMM ;EP;EVALUATE IMMUNIZATION
N S,X,Y,Z,CIMS
S X=$G(^AUPNVIMM(CIMIVDA,0))
Q:'X
Q:$P(+$G(^AUPNVSIT(+$P(X,U,3),0)),".")>$G(CIMDAT)
S Y=$S($L($P($G(^AUTTIMM(+X,0)),U,20))=2:$P(^(0),U,20),1:$P($G(^(0)),U,3))
Q:Y=""
S CIMS=""
I "^02^03^34^42^"[(U_Y_U) S Y="DTP"
I "^06^07^"[(U_Y_U) S Y="IPV"
I "^11^14^15^17^18^"[(U_Y_U) S Y="MMR"
I "^35^37^38^39^"[(U_Y_U) S Y="HIB"
I Y=10 S Y="HEPB"
;I Y=41 S Y="VAR"
;I Y=85 S Y="HEPA"
Q:Y'?3U&(Y'?4U)
S S=$P(X,U,4)
I Y="DTP" D Q:$G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,Y))>3
.S:S>3 CIMS=4
I Y="IPV" D Q:$G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,Y))>2
.S:S>2 CIMS=3
I Y="MMR" D Q:$G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,Y))>0
.S:S>0 CIMS=1
I Y="HIB" D Q:$G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,Y))>2
.S:S>2 CIMS=3
I Y="HEPB" D Q:$G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,Y))>2
.S:S>2 CIMS=3
S:S>CIMS S=CIMS
S ^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,Y)=$S(S>($G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,Y))):S,1:$G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,Y))+1)
Q
COUNT ;COUNT KIDS AND IMMUNIZATIONS
;I $G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,"HEPB"))>2,$G(^("DTP"))>3,$G(^("HIB"))>2,$G(^("IPV"))>1,$G(^("MMR"))>0,$G(^("VAR"))>0 S UPTODATE=1
I $G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,"HEPB"))>2,$G(^("DTP"))>3,$G(^("HIB"))>2,$G(^("IPV"))>1,$G(^("MMR"))>0 S UPTODATE=1
D NEEDS
Q
NEEDS N HRN,NAME,NEEDS,COMMUNIT,DOB
S NAME=$P($G(^DPT(CIMDFN,0)),U)
Q:NAME=""
S Y=$P($G(^DPT(CIMDFN,0)),U,3)
X ^DD("DD")
S DOB=Y
S HRN=$P($G(^AUPNPAT(CIMDFN,41,DUZ(2),0)),U,2)
S COMMUNIT=$P($G(^AUTTCOM(+$P($G(^AUPNPAT(CIMDFN,11)),U,17),0)),U)
S:COMMUNIT="" COMMUNIT="NOT STATED"
S NEEDS=""
I $G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,"DTP"))<4 S NEEDS="DTaP"
I $G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,"IPV"))<3 S NEEDS=NEEDS_$S(NEEDS]"":" & ",1:"")_"IPV"
I $G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,"MMR"))<1 S NEEDS=NEEDS_$S(NEEDS]"":" & ",1:"")_"MMR"
;I $G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,"VAR"))<1 S NEEDS=NEEDS_$S(NEEDS]"":" & ",1:"")_"VAR"
I $G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,"HIB"))<3 S NEEDS=NEEDS_$S(NEEDS]"":" & ",1:"")_"HIB"
I $G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,"HEPB"))<3 S NEEDS=NEEDS_$S(NEEDS]"":" & ",1:"")_"HEPB"
I '$D(UPTODATE) S ^TMP("CIMGAGPR",$J,"NOTUPTODATE",COMMUNIT,NAME)=DOB_U_HRN_U_NEEDS
S:$G(NEEDS)]"" ^TMP("CIMGAGPR",$J,"CHILD",NAME,CIMDFN,"NEEDS")=NEEDS
K ^TMP("CIMGAGPR",$J,"CHILD",CIMDFN)
Q
VARICELL ;SET ARRAY OF ICD9 IEN'S FOR VARICELLA AND DETERMINE IF CHILD HAD DX OF
;VARICELLA, ICD9 DX 052.7, 052.8, OR 052.9
N X,Y
D:'$D(CIMT("VARICELLA")) Q:'$D(CIMT("VARICELLA"))
.F X="052.7","052.8","052.9" D
..S Y=$O(^ICD9("AB",X,0))
..Q:'Y
..S CIMT("VARICELLA",Y)=""
S X=0
F S X=$O(^AUPNVPOV("AC",CIMDFN,X)) Q:'X D
.S Y=$G(^AUPNVPOV(X,0))
.Q:'$D(CIMT("VARICELLA",+Y))
.Q:$P(+$G(^AUPNVSIT(+$P(Y,U,3),0)),".")>CIMDAT
.S ^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,"VAR")=1
Q
CIMGAGPR ; CMI/TUCSON/LAB - ABERDEEN IMM REPORT ;
+1 ;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
+2 ;;
+3 ;;INPUT VARIABLE
+4 ;;
+5 ;; CIMDFN = PATIENT DFN
+6 ;; CIMDAT = DATE FOR IMMUNIZATION STATUS
+7 ;;
+8 ;;OUTPUT VARIABLE = UPTODATE
+9 ;;
+10 ;; UPTODATE = 1 = UPTODATE
+11 ;; UPTODATE = 2 = NOT UPTODATE
+12 ;;
+13 ;;OUTPUT GLOBAL ARRAY
+14 ;;
+15 ;; ^TMP("CIMGAGPR",$J,"LASTNAME,FIRST NAME",CIMDFN,"NEEDS")="LIST OF IMMUNIZATIONS THE CHILD NEEDS"
+16 ;;
KIDS(CIMDFN,CIMDAT) ;EP;DETERMINE CHILDS IMMUNIZATION STATUS
+1 KILL ^TMP("CIMGAGPR",$JOB)
+2 ;D VARICELL
+3 NEW CIMIVDA,UPTODATE
+4 SET CIMIVDA=0
+5 FOR
SET CIMIVDA=$ORDER(^AUPNVIMM("AC",CIMDFN,CIMIVDA))
IF 'CIMIVDA
QUIT
DO IMM
+6 SET UPTODATE=2
+7 DO COUNT
+8 QUIT UPTODATE
IMM ;EP;EVALUATE IMMUNIZATION
+1 NEW S,X,Y,Z,CIMS
+2 SET X=$GET(^AUPNVIMM(CIMIVDA,0))
+3 IF 'X
QUIT
+4 IF $PIECE(+$GET(^AUPNVSIT(+$PIECE(X,U,3),0)),".")>$GET(CIMDAT)
QUIT
+5 SET Y=$SELECT($LENGTH($PIECE($GET(^AUTTIMM(+X,0)),U,20))=2:$PIECE(^(0),U,20),1:$PIECE($GET(^(0)),U,3))
+6 IF Y=""
QUIT
+7 SET CIMS=""
+8 IF "^02^03^34^42^"[(U_Y_U)
SET Y="DTP"
+9 IF "^06^07^"[(U_Y_U)
SET Y="IPV"
+10 IF "^11^14^15^17^18^"[(U_Y_U)
SET Y="MMR"
+11 IF "^35^37^38^39^"[(U_Y_U)
SET Y="HIB"
+12 IF Y=10
SET Y="HEPB"
+13 ;I Y=41 S Y="VAR"
+14 ;I Y=85 S Y="HEPA"
+15 IF Y'?3U&(Y'?4U)
QUIT
+16 SET S=$PIECE(X,U,4)
+17 IF Y="DTP"
Begin DoDot:1
+18 IF S>3
SET CIMS=4
End DoDot:1
IF $GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,Y))>3
QUIT
+19 IF Y="IPV"
Begin DoDot:1
+20 IF S>2
SET CIMS=3
End DoDot:1
IF $GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,Y))>2
QUIT
+21 IF Y="MMR"
Begin DoDot:1
+22 IF S>0
SET CIMS=1
End DoDot:1
IF $GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,Y))>0
QUIT
+23 IF Y="HIB"
Begin DoDot:1
+24 IF S>2
SET CIMS=3
End DoDot:1
IF $GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,Y))>2
QUIT
+25 IF Y="HEPB"
Begin DoDot:1
+26 IF S>2
SET CIMS=3
End DoDot:1
IF $GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,Y))>2
QUIT
+27 IF S>CIMS
SET S=CIMS
+28 SET ^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,Y)=$SELECT(S>($GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,Y))):S,1:$GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,Y))+1)
+29 QUIT
COUNT ;COUNT KIDS AND IMMUNIZATIONS
+1 ;I $G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,"HEPB"))>2,$G(^("DTP"))>3,$G(^("HIB"))>2,$G(^("IPV"))>1,$G(^("MMR"))>0,$G(^("VAR"))>0 S UPTODATE=1
+2 IF $GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,"HEPB"))>2
IF $GET(^("DTP"))>3
IF $GET(^("HIB"))>2
IF $GET(^("IPV"))>1
IF $GET(^("MMR"))>0
SET UPTODATE=1
+3 DO NEEDS
+4 QUIT
NEEDS NEW HRN,NAME,NEEDS,COMMUNIT,DOB
+1 SET NAME=$PIECE($GET(^DPT(CIMDFN,0)),U)
+2 IF NAME=""
QUIT
+3 SET Y=$PIECE($GET(^DPT(CIMDFN,0)),U,3)
+4 XECUTE ^DD("DD")
+5 SET DOB=Y
+6 SET HRN=$PIECE($GET(^AUPNPAT(CIMDFN,41,DUZ(2),0)),U,2)
+7 SET COMMUNIT=$PIECE($GET(^AUTTCOM(+$PIECE($GET(^AUPNPAT(CIMDFN,11)),U,17),0)),U)
+8 IF COMMUNIT=""
SET COMMUNIT="NOT STATED"
+9 SET NEEDS=""
+10 IF $GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,"DTP"))<4
SET NEEDS="DTaP"
+11 IF $GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,"IPV"))<3
SET NEEDS=NEEDS_$SELECT(NEEDS]"":" & ",1:"")_"IPV"
+12 IF $GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,"MMR"))<1
SET NEEDS=NEEDS_$SELECT(NEEDS]"":" & ",1:"")_"MMR"
+13 ;I $G(^TMP("CIMGAGPR",$J,"CHILD",CIMDFN,"VAR"))<1 S NEEDS=NEEDS_$S(NEEDS]"":" & ",1:"")_"VAR"
+14 IF $GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,"HIB"))<3
SET NEEDS=NEEDS_$SELECT(NEEDS]"":" & ",1:"")_"HIB"
+15 IF $GET(^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,"HEPB"))<3
SET NEEDS=NEEDS_$SELECT(NEEDS]"":" & ",1:"")_"HEPB"
+16 IF '$DATA(UPTODATE)
SET ^TMP("CIMGAGPR",$JOB,"NOTUPTODATE",COMMUNIT,NAME)=DOB_U_HRN_U_NEEDS
+17 IF $GET(NEEDS)]""
SET ^TMP("CIMGAGPR",$JOB,"CHILD",NAME,CIMDFN,"NEEDS")=NEEDS
+18 KILL ^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN)
+19 QUIT
VARICELL ;SET ARRAY OF ICD9 IEN'S FOR VARICELLA AND DETERMINE IF CHILD HAD DX OF
+1 ;VARICELLA, ICD9 DX 052.7, 052.8, OR 052.9
+2 NEW X,Y
+3 IF '$DATA(CIMT("VARICELLA"))
Begin DoDot:1
+4 FOR X="052.7","052.8","052.9"
Begin DoDot:2
+5 SET Y=$ORDER(^ICD9("AB",X,0))
+6 IF 'Y
QUIT
+7 SET CIMT("VARICELLA",Y)=""
End DoDot:2
End DoDot:1
IF '$DATA(CIMT("VARICELLA"))
QUIT
+8 SET X=0
+9 FOR
SET X=$ORDER(^AUPNVPOV("AC",CIMDFN,X))
IF 'X
QUIT
Begin DoDot:1
+10 SET Y=$GET(^AUPNVPOV(X,0))
+11 IF '$DATA(CIMT("VARICELLA",+Y))
QUIT
+12 IF $PIECE(+$GET(^AUPNVSIT(+$PIECE(Y,U,3),0)),".")>CIMDAT
QUIT
+13 SET ^TMP("CIMGAGPR",$JOB,"CHILD",CIMDFN,"VAR")=1
End DoDot:1
+14 QUIT
