BIREPP3 ;IHS/CMI/MWR - REPORT, PCV; AUG 10,2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW OR PRINT REPORT.
;
;
;----------
GETIMMS(BIBEGDT,BIENDDT,BICC,BIUP) ;EP
;---> Get Immunizations from V Files.
;---> Parameters:
; 1 - BIBEGDT (req) Begin Visit Date.
; 2 - BIENDDT (req) End Visit Date.
; 3 - BICC (req) Current Community array.
; 4 - BIUP (req) User Population/Group (r,i,u,a).
;
;---> Set begin and end dates for search through PATIENT File.
;
Q:'$G(BIBEGDT) Q:'$G(BIENDDT)
;---> Begin at earliest possible DOB (kids born the day after
;---> 5 years prior to the End Date).
N N S N=($E(BIENDDT,1,3)-5)_$E(BIENDDT,4,7)
F S N=$O(^DPT("ADOB",N)) Q:(N>BIENDDT!('N)) D
.S BIDFN=0
.F S BIDFN=$O(^DPT("ADOB",N,BIDFN)) Q:'BIDFN D
..D CHKSET(BIDFN,.BICC,BIUP,BIBEGDT,BIENDDT)
Q
;
;
;----------
CHKSET(BIDFN,BICC,BIUP,BIBEGDT,BIENDDT) ;EP
;---> Check if this patient fits criteria; if so, set DFN
;---> in ^TMP("BIREPQ1".
;---> Parameters:
; 1 - BIDFN (req) Patient IEN.
; 2 - BICC (req) Current Community array.
; 3 - BIUP (req) User Population/Group (r,i,u,a).
; 4 - BIBEGDT (req) Begin Visit Date.
; 5 - BIENDDT (req) End Visit Date.
;
Q:'$G(BIDFN)
Q:'$D(BICC)
Q:'$D(BIUP)
Q:'$G(BIBEGDT)
Q:'$G(BIENDDT)
;
;---> Quit if patient not less than 60 months (5 yrs) old on the End Date.
S BIAGE=$$AGE^BIUTL1(BIDFN,2,BIENDDT)
Q:(BIAGE'?1N.N) Q:(BIAGE>59)
;
N BIHCF S BIHCF($G(DUZ(2)))=""
;---> Filter for standard Patient Population parameter.
Q:'$$PPFILTR^BIREP(BIDFN,.BIHCF,BIENDDT,BIUP)
;
;---> Quit if Current Community doesn't match.
Q:$$CURCOM^BIEXPRT2(BIDFN,.BICC)
;
;---> *** Okay, this patient is in the denominator. *****************
;
;---> Get Age Groups string (12345) for this patient.
N BIAGRPS S BIAGRPS=$$AGEGRP(BIAGE)
;
;---> Get Lastname,Firstname.
N BIPNAME S BIPNAME=$$NAME^BIUTL1(BIDFN)
;
;---> Store in denominator total.
N BIAGRP,I F I=1:1 S BIAGRP=$E(BIAGRPS,I) Q:'BIAGRP D
.S ^TMP("BIREPP1",$J,"TOTALPATS",BIAGRP)=$G(^TMP("BIREPP1",$J,"TOTALPATS",BIAGRP))+1
;
;---> Store patient for export (even if no PCV's).
S ^TMP("BIREPP1",$J,"BIDFN",BIDFN,"EXPORT")=""
;
;---> Store patient for viewing Denominator.
S ^TMP("BIDUL",$J,1,BIAGE,BIPNAME,BIDFN)=""
;
;---> RPC to gather Immunization History.
N BI31,BIDE,BIRETVAL,BIRETERR,I S BI31=$C(31)_$C(31),BIRETVAL=""
;---> 25=CVX, 55=Vaccine Group IEN, 56=Date of Visit (Fileman), 65=Dose Override.
F I=25,55,56,65 S BIDE(I)=""
;---> Fourth parameter=0: Do not return Skin Tests.
;---> Fifth parameter=0: Split out combinations as if given individually.
D IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,0,0)
;
;---> If BIRETERR has a value, store it and quit.
S BIRETERR=$P(BIRETVAL,BI31,2)
Q:BIRETERR]""
Q:BIRETVAL["NO RECORDS"
;
;---> Set BIHX=to a valid Immunization History.
N BIHX S BIHX=$P(BIRETVAL,BI31,1)
;
;---> Add this Patient's History to stats.
N I,Y
;---> Loop through "^"-pieces of Imm History, getting data.
F I=1:1 S Y=$P(BIHX,U,I) Q:Y="" D
.;
.;---> Quit (don't count) if Visit was AFTER Quarter Ending Date.
.N BIDATE S BIDATE=$P(Y,"|",4)
.Q:(BIDATE>BIENDDT)
.;
.;---> Quit (don't count) if Vaccine Group is not Pneumo (IEN in ^BISERT=11).
.Q:($P(Y,"|",3)'=11)
.;
.;---> Set CVX Code and Invalid Code (Dose Override).
.N BICVX S BICVX=$P(Y,"|",2)
.N BINVLD S BINVLD=$P(Y,"|",5) D
..I (BINVLD>0)&(BINVLD<9) S BINVLD=$$DOVER^BIUTL8(BINVLD,1) Q
..S BINVLD=""
.;
.;---> EXPORT, store data lines.
.;---> Use "," for CSV delimiter in Export.
.N Q,D S Q="""",D=Q_","_Q
.N X S X=BICVX_D_$$SLDT1^BIUTL5($P(Y,"|",4))_D_BINVLD_D
.;--->Add or update patient node for export.
.N Y S Y=$G(^TMP("BIREPP1",$J,"BIDFN",BIDFN,"EXPORT"))
.S ^TMP("BIREPP1",$J,"BIDFN",BIDFN,"EXPORT")=Y_X
.;
.;---> REPORT, store patient tallies.
.;---> For each Age Group to which this patient belongs, update doses of PCV13 received.
.Q:BICVX'=133
.;
.S Y=$G(^TMP("BIREPP1",$J,"BIDFN",BIDFN,BIAGRPS,"DOSES"))
.S ^TMP("BIREPP1",$J,"BIDFN",BIDFN,BIAGRPS,"DOSES")=Y+1
.;
.;---> Do not include this dose in the Total PCV13 Doses Administered if it is not in
.;---> the requested DATE RANGE.
.Q:(BIDATE<BIBEGDT) Q:(BIDATE>(BIENDDT+.9999))
.;
.;---> Update Total PCV13 Doses Administered.
.N BIAGRP,I F I=1:1 S BIAGRP=$E(BIAGRPS,I) Q:'BIAGRP D
..S ^TMP("BIREPP1",$J,"TOTALPCV13",BIAGRP)=$G(^TMP("BIREPP1",$J,"TOTALPCV13",BIAGRP))+1
;
Q
;
;
TALLY ;EP
;---> Tally up the numbers of children in each age group who have received
;---> 1, 3, or 4 doses.
;
N BIDFN S BIDFN=0
F S BIDFN=$O(^TMP("BIREPP1",$J,"BIDFN",BIDFN)) Q:'BIDFN D
.N BIAGRPS S BIAGRPS=0 S BIAGRPS=$O(^TMP("BIREPP1",$J,"BIDFN",BIDFN,BIAGRPS))
.Q:'BIAGRPS
.N BIDOSES S BIDOSES=$G(^TMP("BIREPP1",$J,"BIDFN",BIDFN,BIAGRPS,"DOSES"))
.Q:'BIDOSES
.N BIAGRP,I F I=1:1 S BIAGRP=$E(BIAGRPS,I) Q:'BIAGRP D
..N Z S Z=$G(^TMP("BIREPP1",$J,"TALLY",1,BIAGRP))
..S ^TMP("BIREPP1",$J,"TALLY",1,BIAGRP)=Z+1
..Q:(BIDOSES=1)
..N Z S Z=$G(^TMP("BIREPP1",$J,"TALLY",3,BIAGRP))
..S ^TMP("BIREPP1",$J,"TALLY",3,BIAGRP)=Z+1
..Q:(BIDOSES=3)
..N Z S Z=$G(^TMP("BIREPP1",$J,"TALLY",4,BIAGRP))
..S ^TMP("BIREPP1",$J,"TALLY",4,BIAGRP)=Z+1
;
Q
;
;
;----------
AGEGRP(BIAGE) ;EP
;---> Return Patient's Age GroupS.
;---> Parameters:
; 1 - BIAGE (req) Patient's age in months.
;
;---> NOTE: All patients at this point fall into Age Group 1 (0-59 months).
N X S X=1
I BIAGE>1,BIAGE<24 S X=X_2
I BIAGE>23,BIAGE<60 S X=X_3
I BIAGE>5,BIAGE<12 S X=X_4
I BIAGE>11,BIAGE<24 S X=X_5
Q X
BIREPP3 ;IHS/CMI/MWR - REPORT, PCV; AUG 10,2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW OR PRINT REPORT.
+4 ;
+5 ;
+6 ;----------
GETIMMS(BIBEGDT,BIENDDT,BICC,BIUP) ;EP
+1 ;---> Get Immunizations from V Files.
+2 ;---> Parameters:
+3 ; 1 - BIBEGDT (req) Begin Visit Date.
+4 ; 2 - BIENDDT (req) End Visit Date.
+5 ; 3 - BICC (req) Current Community array.
+6 ; 4 - BIUP (req) User Population/Group (r,i,u,a).
+7 ;
+8 ;---> Set begin and end dates for search through PATIENT File.
+9 ;
+10 IF '$GET(BIBEGDT)
QUIT
IF '$GET(BIENDDT)
QUIT
+11 ;---> Begin at earliest possible DOB (kids born the day after
+12 ;---> 5 years prior to the End Date).
+13 NEW N
SET N=($EXTRACT(BIENDDT,1,3)-5)_$EXTRACT(BIENDDT,4,7)
+14 FOR
SET N=$ORDER(^DPT("ADOB",N))
IF (N>BIENDDT!('N))
QUIT
Begin DoDot:1
+15 SET BIDFN=0
+16 FOR
SET BIDFN=$ORDER(^DPT("ADOB",N,BIDFN))
IF 'BIDFN
QUIT
Begin DoDot:2
+17 DO CHKSET(BIDFN,.BICC,BIUP,BIBEGDT,BIENDDT)
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
+20 ;
+21 ;----------
CHKSET(BIDFN,BICC,BIUP,BIBEGDT,BIENDDT) ;EP
+1 ;---> Check if this patient fits criteria; if so, set DFN
+2 ;---> in ^TMP("BIREPQ1".
+3 ;---> Parameters:
+4 ; 1 - BIDFN (req) Patient IEN.
+5 ; 2 - BICC (req) Current Community array.
+6 ; 3 - BIUP (req) User Population/Group (r,i,u,a).
+7 ; 4 - BIBEGDT (req) Begin Visit Date.
+8 ; 5 - BIENDDT (req) End Visit Date.
+9 ;
+10 IF '$GET(BIDFN)
QUIT
+11 IF '$DATA(BICC)
QUIT
+12 IF '$DATA(BIUP)
QUIT
+13 IF '$GET(BIBEGDT)
QUIT
+14 IF '$GET(BIENDDT)
QUIT
+15 ;
+16 ;---> Quit if patient not less than 60 months (5 yrs) old on the End Date.
+17 SET BIAGE=$$AGE^BIUTL1(BIDFN,2,BIENDDT)
+18 IF (BIAGE'?1N.N)
QUIT
IF (BIAGE>59)
QUIT
+19 ;
+20 NEW BIHCF
SET BIHCF($GET(DUZ(2)))=""
+21 ;---> Filter for standard Patient Population parameter.
+22 IF '$$PPFILTR^BIREP(BIDFN,.BIHCF,BIENDDT,BIUP)
QUIT
+23 ;
+24 ;---> Quit if Current Community doesn't match.
+25 IF $$CURCOM^BIEXPRT2(BIDFN,.BICC)
QUIT
+26 ;
+27 ;---> *** Okay, this patient is in the denominator. *****************
+28 ;
+29 ;---> Get Age Groups string (12345) for this patient.
+30 NEW BIAGRPS
SET BIAGRPS=$$AGEGRP(BIAGE)
+31 ;
+32 ;---> Get Lastname,Firstname.
+33 NEW BIPNAME
SET BIPNAME=$$NAME^BIUTL1(BIDFN)
+34 ;
+35 ;---> Store in denominator total.
+36 NEW BIAGRP,I
FOR I=1:1
SET BIAGRP=$EXTRACT(BIAGRPS,I)
IF 'BIAGRP
QUIT
Begin DoDot:1
+37 SET ^TMP("BIREPP1",$JOB,"TOTALPATS",BIAGRP)=$GET(^TMP("BIREPP1",$JOB,"TOTALPATS",BIAGRP))+1
End DoDot:1
+38 ;
+39 ;---> Store patient for export (even if no PCV's).
+40 SET ^TMP("BIREPP1",$JOB,"BIDFN",BIDFN,"EXPORT")=""
+41 ;
+42 ;---> Store patient for viewing Denominator.
+43 SET ^TMP("BIDUL",$JOB,1,BIAGE,BIPNAME,BIDFN)=""
+44 ;
+45 ;---> RPC to gather Immunization History.
+46 NEW BI31,BIDE,BIRETVAL,BIRETERR,I
SET BI31=$CHAR(31)_$CHAR(31)
SET BIRETVAL=""
+47 ;---> 25=CVX, 55=Vaccine Group IEN, 56=Date of Visit (Fileman), 65=Dose Override.
+48 FOR I=25,55,56,65
SET BIDE(I)=""
+49 ;---> Fourth parameter=0: Do not return Skin Tests.
+50 ;---> Fifth parameter=0: Split out combinations as if given individually.
+51 DO IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,0,0)
+52 ;
+53 ;---> If BIRETERR has a value, store it and quit.
+54 SET BIRETERR=$PIECE(BIRETVAL,BI31,2)
+55 IF BIRETERR]""
QUIT
+56 IF BIRETVAL["NO RECORDS"
QUIT
+57 ;
+58 ;---> Set BIHX=to a valid Immunization History.
+59 NEW BIHX
SET BIHX=$PIECE(BIRETVAL,BI31,1)
+60 ;
+61 ;---> Add this Patient's History to stats.
+62 NEW I,Y
+63 ;---> Loop through "^"-pieces of Imm History, getting data.
+64 FOR I=1:1
SET Y=$PIECE(BIHX,U,I)
IF Y=""
QUIT
Begin DoDot:1
+65 ;
+66 ;---> Quit (don't count) if Visit was AFTER Quarter Ending Date.
+67 NEW BIDATE
SET BIDATE=$PIECE(Y,"|",4)
+68 IF (BIDATE>BIENDDT)
QUIT
+69 ;
+70 ;---> Quit (don't count) if Vaccine Group is not Pneumo (IEN in ^BISERT=11).
+71 IF ($PIECE(Y,"|",3)'=11)
QUIT
+72 ;
+73 ;---> Set CVX Code and Invalid Code (Dose Override).
+74 NEW BICVX
SET BICVX=$PIECE(Y,"|",2)
+75 NEW BINVLD
SET BINVLD=$PIECE(Y,"|",5)
Begin DoDot:2
+76 IF (BINVLD>0)&(BINVLD<9)
SET BINVLD=$$DOVER^BIUTL8(BINVLD,1)
QUIT
+77 SET BINVLD=""
End DoDot:2
+78 ;
+79 ;---> EXPORT, store data lines.
+80 ;---> Use "," for CSV delimiter in Export.
+81 NEW Q,D
SET Q=""""
SET D=Q_","_Q
+82 NEW X
SET X=BICVX_D_$$SLDT1^BIUTL5($PIECE(Y,"|",4))_D_BINVLD_D
+83 ;--->Add or update patient node for export.
+84 NEW Y
SET Y=$GET(^TMP("BIREPP1",$JOB,"BIDFN",BIDFN,"EXPORT"))
+85 SET ^TMP("BIREPP1",$JOB,"BIDFN",BIDFN,"EXPORT")=Y_X
+86 ;
+87 ;---> REPORT, store patient tallies.
+88 ;---> For each Age Group to which this patient belongs, update doses of PCV13 received.
+89 IF BICVX'=133
QUIT
+90 ;
+91 SET Y=$GET(^TMP("BIREPP1",$JOB,"BIDFN",BIDFN,BIAGRPS,"DOSES"))
+92 SET ^TMP("BIREPP1",$JOB,"BIDFN",BIDFN,BIAGRPS,"DOSES")=Y+1
+93 ;
+94 ;---> Do not include this dose in the Total PCV13 Doses Administered if it is not in
+95 ;---> the requested DATE RANGE.
+96 IF (BIDATE<BIBEGDT)
QUIT
IF (BIDATE>(BIENDDT+.9999))
QUIT
+97 ;
+98 ;---> Update Total PCV13 Doses Administered.
+99 NEW BIAGRP,I
FOR I=1:1
SET BIAGRP=$EXTRACT(BIAGRPS,I)
IF 'BIAGRP
QUIT
Begin DoDot:2
+100 SET ^TMP("BIREPP1",$JOB,"TOTALPCV13",BIAGRP)=$GET(^TMP("BIREPP1",$JOB,"TOTALPCV13",BIAGRP))+1
End DoDot:2
End DoDot:1
+101 ;
+102 QUIT
+103 ;
+104 ;
TALLY ;EP
+1 ;---> Tally up the numbers of children in each age group who have received
+2 ;---> 1, 3, or 4 doses.
+3 ;
+4 NEW BIDFN
SET BIDFN=0
+5 FOR
SET BIDFN=$ORDER(^TMP("BIREPP1",$JOB,"BIDFN",BIDFN))
IF 'BIDFN
QUIT
Begin DoDot:1
+6 NEW BIAGRPS
SET BIAGRPS=0
SET BIAGRPS=$ORDER(^TMP("BIREPP1",$JOB,"BIDFN",BIDFN,BIAGRPS))
+7 IF 'BIAGRPS
QUIT
+8 NEW BIDOSES
SET BIDOSES=$GET(^TMP("BIREPP1",$JOB,"BIDFN",BIDFN,BIAGRPS,"DOSES"))
+9 IF 'BIDOSES
QUIT
+10 NEW BIAGRP,I
FOR I=1:1
SET BIAGRP=$EXTRACT(BIAGRPS,I)
IF 'BIAGRP
QUIT
Begin DoDot:2
+11 NEW Z
SET Z=$GET(^TMP("BIREPP1",$JOB,"TALLY",1,BIAGRP))
+12 SET ^TMP("BIREPP1",$JOB,"TALLY",1,BIAGRP)=Z+1
+13 IF (BIDOSES=1)
QUIT
+14 NEW Z
SET Z=$GET(^TMP("BIREPP1",$JOB,"TALLY",3,BIAGRP))
+15 SET ^TMP("BIREPP1",$JOB,"TALLY",3,BIAGRP)=Z+1
+16 IF (BIDOSES=3)
QUIT
+17 NEW Z
SET Z=$GET(^TMP("BIREPP1",$JOB,"TALLY",4,BIAGRP))
+18 SET ^TMP("BIREPP1",$JOB,"TALLY",4,BIAGRP)=Z+1
End DoDot:2
End DoDot:1
+19 ;
+20 QUIT
+21 ;
+22 ;
+23 ;----------
AGEGRP(BIAGE) ;EP
+1 ;---> Return Patient's Age GroupS.
+2 ;---> Parameters:
+3 ; 1 - BIAGE (req) Patient's age in months.
+4 ;
+5 ;---> NOTE: All patients at this point fall into Age Group 1 (0-59 months).
+6 NEW X
SET X=1
+7 IF BIAGE>1
IF BIAGE<24
SET X=X_2
+8 IF BIAGE>23
IF BIAGE<60
SET X=X_3
+9 IF BIAGE>5
IF BIAGE<12
SET X=X_4
+10 IF BIAGE>11
IF BIAGE<24
SET X=X_5
+11 QUIT X
