- 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
