- 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
