BIREPF3 ;IHS/CMI/MWR - REPORT, FLU IMM; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW INFLUENZA IMMUNIZATION REPORT.
;
;
;----------
AGETOT(BILINE,BICC,BIHCF,BICM,BIBEN,BIYEAR,BIPOP,BIFH,BIUP) ;EP
;---> Write Age Total line.
;---> Parameters:
; 1 - BILINE (req) Line number in ^TMP Listman array.
; 2 - BICC (req) Current Community array.
; 3 - BIHCF (req) Health Care Facility array.
; 4 - BICM (req) Case Manager array.
; 5 - BIBEN (req) Beneficiary Type array.
; 6 - BIYEAR (req) Report Year^m (if 2nd pc="m", then End Date=March 31 of
; the report year; otherwise End Date=Dec 31 of BIYEAR)
; 7 - BIPOP (ret) BIPOP=1 if error.
; 8 - BIFH (opt) F=report on Flu Vaccine Group (default), H=H1N1 group.
; 9 - BIUP (req) User Population/Group (Registered, Imm, User, Active).
;
S BIPOP=0
S:($G(BIFH)="") BIFH="F"
S:$G(BIUP)="" BIUP="u"
;---> Check for required Variables.
I '$G(BIYEAR) D ERRCD^BIUTL2(679,.X) D WRITERR^BIREPF2(BILINE,X) S BIPOP=1 Q
N BIQDT S BIQDT=(BIYEAR-1700)_1231
;
;---> Gather and sort patients.
N N S N=0
F I="10-23","24-59","60-215","216-599","600-779","780-1500" D
.;---> For each age range, get Begin and End Dates (DOB's).
.D AGEDATE^BIAGE(I,BIQDT,.BIBEGDT,.BIENDDT)
.;---> Leave an Age Group=5 for High Risk (subset of Group 4
.S N=N+1 S:(N=5) N=6
.D GETPATS^BIREPF4(BIBEGDT,BIENDDT,N,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIFH,BIYEAR,BIUP)
;
;---> Count patients.
N BIAGRP,BITOT S BITOT=0
F I=1:1:7 D
.N M,N S M=0,N=0,BIAGRP(I)=0
.F S N=$O(^TMP("BIREPF1",$J,"PATS",I,N)) Q:'N D
..;---> Yes, now include Age Group 5 (18-49 High Risk) in Totals.
..;S BIAGRP(I)=BIAGRP(I)+1 S:(I'=5) BITOT=BITOT+1
..S BIAGRP(I)=BIAGRP(I)+1 S BITOT=BITOT+1
.S BITMP("STATS","TOTAL",I)=BIAGRP(I)
S BITMP("STATS","TOTAL","ALL")=BITOT
;
;---> Write Age Totals line.
;N X S X=" # in Age |"
N X S X=" Denominator |"
;X ^O
F I=1:1:7 S X=X_$J($G(BIAGRP(I)),6)_" "
S X=$E(X,1,$L(X)-2)_" |"_$J(BITOT,7)
D WRITE(.BILINE,X)
D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
Q
;
;
;----------
VGRP(BILINE,BIVGRP,BIYEAR) ;EP
;---> Write Stats lines for each Vaccine Group.
;---> Parameters:
; 1 - BILINE (req) Line number in ^TMP Listman array.
; 2 - BIVGRP (req) IEN of Vaccine Group.
; 3 - BIYEAR (req) Report Year.
;
;---> Write a line for each Dose of this Vaccine Group.
;N BIDOSE,BIMAXD S BIMAXD=$$VGROUP^BIUTL2(BIVGRP,6)
N BIDOSE,BIMAXD S BIMAXD=1
;---> For H1N1 Report display 2 doses.
S:BIVGRP=18 BIMAXD=2
F BIDOSE=1:1:BIMAXD D
.;
.;---> *** WRITE DOSE 1 LINE:
.;---> BIX=text of the line to write.
.;---> Write the Dose#-Vaccine Group in left margin.
.N BIX S BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)
.S BIX=$$PAD^BIUTL5(BIX,13)_"|"
.;
.;---> Now loop through the Age Groups, concating subtotals.
.N BIAGRP,BISUBT S BISUBT=0
.F BIAGRP=1:1:7 D
..;---> BITMP(Vaccine Grp, CURRENT Season, Dose, Age Grp)
..N Y S Y=+$G(BITMP("STATS",BIVGRP,1,BIDOSE,BIAGRP))
..;---> Write stats for each Age Group, but don't include 5 in total.
..;S BIX=BIX_$J(Y,6)_" " S:(BIAGRP'=5) BISUBT=BISUBT+Y
..;---> Yes, now include Age Group 5 (18-49 High Risk) in Totals.
..S BIX=BIX_$J(Y,6)_" " S BISUBT=BISUBT+Y
.;
.S BIX=$E(BIX,1,$L(BIX)-2)_" |"_$J(BISUBT,7)
.D WRITE(.BILINE,BIX)
.I BIDOSE=1 D MARK^BIW(BILINE,BIMAXD+2,"BIREPF1")
.;
.;---> *** NOW WRITE PERCENTAGES LINE:
.;---> BIX=text of the line to write.
.;---> Write "YYYY Season" in left margin.
.S:'$G(BIYEAR) BIYEAR="YYYY"
.K BIX N BIX S BIX=" "_+BIYEAR_" Season "
.S BIX=$$PAD^BIUTL5(BIX,13)_"|"
.;
.;---> Now loop through the Age Groups, writing percentages.
.F BIAGRP=1:1:7 D
..;---> BITMP(Vaccine Grp, CURRENT Season, Dose, Age Grp)
..N Y S Y=$G(BITMP("STATS",BIVGRP,1,BIDOSE,BIAGRP)) S:Y="" Y=0
..N Z S Z=$G(BITMP("STATS","TOTAL",BIAGRP)) S:'Z Y=0,Z=1
..S BIX=BIX_" "_$J((100*Y/Z),3,0)_"% "
.;
.;---> Now write total percentage.
.N Y S Y=BISUBT S:Y="" Y=0
.N Z S Z=$G(BITMP("STATS","TOTAL","ALL")) S:'Z Y=0,Z=1
.S BIX=$$PAD^BIUTL5(BIX,69)_"| "_$J((100*Y/Z),3,0)_"%"
.D WRITE(.BILINE,BIX)
.;---> If H1N1, write final line (since we won't write a "Fully Immunized" row).
.D:BIVGRP=18 WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
;
;---> Do not write for H1N1 (since we won't write a "Fully Immunized" row).
D:BIVGRP'=18 WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
Q
;
;
;----------
APPROP(BILINE) ;EP
;---> Write Appropriate for Age lines.
;---> Parameters:
; 1 - BILINE (req) Line number in ^TMP Listman array.
;
;---> Numbers of appropriate line.
;N BITOT,X S BITOT=0,X=" Appropriate |"
N BITOT,X S BITOT=0,X=" Fully |"
F BIAGRP=1:1:7 D
.N Y S Y=$G(BITMP("STATS","APPRO",BIAGRP)) S:Y="" Y=0
.;---> Yes, now include Age Group 5 (18-49 High Risk) in Totals.
.;S X=X_$J(Y,6)_" " S:(BIAGRP'=5) BITOT=BITOT+Y
.S X=X_$J(Y,6)_" " S BITOT=BITOT+Y
;
S X=$E(X,1,$L(X)-2) S X=$$PAD^BIUTL5(X,69)_"|"_$J(BITOT,7)
D WRITE(.BILINE,X)
D MARK^BIW(BILINE,3,"BIREPF1")
;
;---> Percentage of appropriate line.
;S X=" for Age |",BITOT=0
S X=" Immunized |",BITOT=0
F BIAGRP=1:1:7 D
.N Y S Y=$G(BITMP("STATS","APPRO",BIAGRP)) S:Y="" Y=0
.N Z S Z=$G(BITMP("STATS","TOTAL",BIAGRP)) S:'Z Y=0,Z=1
.N BIPERC S BIPERC=" "_$J((100*Y/Z),3,0)_"%"
.S X=X_BIPERC_" " S:(BIAGRP'=5) BITOT=BITOT+Y
;
N Y S Y=BITOT S:Y="" Y=0
N Z S Z=$G(BITMP("STATS","TOTAL","ALL")) S:'Z Y=0,Z=1
;S X=$E(X,1,$L(X)-2)_"| "_$J((100*Y/Z),3,0)_"%"
S X=$E(X,1,$L(X)-1) S X=$$PAD^BIUTL5(X,69)_"| "_$J((100*Y/Z),3,0)_"%"
D WRITE(.BILINE,X)
D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
Q
;
;
;----------
WRITE(BILINE,BIVAL,BIBLNK) ;EP
;---> Write lines to ^TMP (see documentation in ^BIW).
;---> Parameters:
; 1 - BILINE (ret) Last line# written.
; 2 - BIVAL (opt) Value/text of line (Null=blank line).
;
Q:'$D(BILINE)
D WL^BIW(.BILINE,"BIREPF1",$G(BIVAL),$G(BIBLNK))
Q
BIREPF3 ;IHS/CMI/MWR - REPORT, FLU IMM; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW INFLUENZA IMMUNIZATION REPORT.
+4 ;
+5 ;
+6 ;----------
AGETOT(BILINE,BICC,BIHCF,BICM,BIBEN,BIYEAR,BIPOP,BIFH,BIUP) ;EP
+1 ;---> Write Age Total line.
+2 ;---> Parameters:
+3 ; 1 - BILINE (req) Line number in ^TMP Listman array.
+4 ; 2 - BICC (req) Current Community array.
+5 ; 3 - BIHCF (req) Health Care Facility array.
+6 ; 4 - BICM (req) Case Manager array.
+7 ; 5 - BIBEN (req) Beneficiary Type array.
+8 ; 6 - BIYEAR (req) Report Year^m (if 2nd pc="m", then End Date=March 31 of
+9 ; the report year; otherwise End Date=Dec 31 of BIYEAR)
+10 ; 7 - BIPOP (ret) BIPOP=1 if error.
+11 ; 8 - BIFH (opt) F=report on Flu Vaccine Group (default), H=H1N1 group.
+12 ; 9 - BIUP (req) User Population/Group (Registered, Imm, User, Active).
+13 ;
+14 SET BIPOP=0
+15 IF ($GET(BIFH)="")
SET BIFH="F"
+16 IF $GET(BIUP)=""
SET BIUP="u"
+17 ;---> Check for required Variables.
+18 IF '$GET(BIYEAR)
DO ERRCD^BIUTL2(679,.X)
DO WRITERR^BIREPF2(BILINE,X)
SET BIPOP=1
QUIT
+19 NEW BIQDT
SET BIQDT=(BIYEAR-1700)_1231
+20 ;
+21 ;---> Gather and sort patients.
+22 NEW N
SET N=0
+23 FOR I="10-23","24-59","60-215","216-599","600-779","780-1500"
Begin DoDot:1
+24 ;---> For each age range, get Begin and End Dates (DOB's).
+25 DO AGEDATE^BIAGE(I,BIQDT,.BIBEGDT,.BIENDDT)
+26 ;---> Leave an Age Group=5 for High Risk (subset of Group 4
+27 SET N=N+1
IF (N=5)
SET N=6
+28 DO GETPATS^BIREPF4(BIBEGDT,BIENDDT,N,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIFH,BIYEAR,BIUP)
End DoDot:1
+29 ;
+30 ;---> Count patients.
+31 NEW BIAGRP,BITOT
SET BITOT=0
+32 FOR I=1:1:7
Begin DoDot:1
+33 NEW M,N
SET M=0
SET N=0
SET BIAGRP(I)=0
+34 FOR
SET N=$ORDER(^TMP("BIREPF1",$JOB,"PATS",I,N))
IF 'N
QUIT
Begin DoDot:2
+35 ;---> Yes, now include Age Group 5 (18-49 High Risk) in Totals.
+36 ;S BIAGRP(I)=BIAGRP(I)+1 S:(I'=5) BITOT=BITOT+1
+37 SET BIAGRP(I)=BIAGRP(I)+1
SET BITOT=BITOT+1
End DoDot:2
+38 SET BITMP("STATS","TOTAL",I)=BIAGRP(I)
End DoDot:1
+39 SET BITMP("STATS","TOTAL","ALL")=BITOT
+40 ;
+41 ;---> Write Age Totals line.
+42 ;N X S X=" # in Age |"
+43 NEW X
SET X=" Denominator |"
+44 ;X ^O
+45 FOR I=1:1:7
SET X=X_$JUSTIFY($GET(BIAGRP(I)),6)_" "
+46 SET X=$EXTRACT(X,1,$LENGTH(X)-2)_" |"_$JUSTIFY(BITOT,7)
+47 DO WRITE(.BILINE,X)
+48 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+49 QUIT
+50 ;
+51 ;
+52 ;----------
VGRP(BILINE,BIVGRP,BIYEAR) ;EP
+1 ;---> Write Stats lines for each Vaccine Group.
+2 ;---> Parameters:
+3 ; 1 - BILINE (req) Line number in ^TMP Listman array.
+4 ; 2 - BIVGRP (req) IEN of Vaccine Group.
+5 ; 3 - BIYEAR (req) Report Year.
+6 ;
+7 ;---> Write a line for each Dose of this Vaccine Group.
+8 ;N BIDOSE,BIMAXD S BIMAXD=$$VGROUP^BIUTL2(BIVGRP,6)
+9 NEW BIDOSE,BIMAXD
SET BIMAXD=1
+10 ;---> For H1N1 Report display 2 doses.
+11 IF BIVGRP=18
SET BIMAXD=2
+12 FOR BIDOSE=1:1:BIMAXD
Begin DoDot:1
+13 ;
+14 ;---> *** WRITE DOSE 1 LINE:
+15 ;---> BIX=text of the line to write.
+16 ;---> Write the Dose#-Vaccine Group in left margin.
+17 NEW BIX
SET BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)
+18 SET BIX=$$PAD^BIUTL5(BIX,13)_"|"
+19 ;
+20 ;---> Now loop through the Age Groups, concating subtotals.
+21 NEW BIAGRP,BISUBT
SET BISUBT=0
+22 FOR BIAGRP=1:1:7
Begin DoDot:2
+23 ;---> BITMP(Vaccine Grp, CURRENT Season, Dose, Age Grp)
+24 NEW Y
SET Y=+$GET(BITMP("STATS",BIVGRP,1,BIDOSE,BIAGRP))
+25 ;---> Write stats for each Age Group, but don't include 5 in total.
+26 ;S BIX=BIX_$J(Y,6)_" " S:(BIAGRP'=5) BISUBT=BISUBT+Y
+27 ;---> Yes, now include Age Group 5 (18-49 High Risk) in Totals.
+28 SET BIX=BIX_$JUSTIFY(Y,6)_" "
SET BISUBT=BISUBT+Y
End DoDot:2
+29 ;
+30 SET BIX=$EXTRACT(BIX,1,$LENGTH(BIX)-2)_" |"_$JUSTIFY(BISUBT,7)
+31 DO WRITE(.BILINE,BIX)
+32 IF BIDOSE=1
DO MARK^BIW(BILINE,BIMAXD+2,"BIREPF1")
+33 ;
+34 ;---> *** NOW WRITE PERCENTAGES LINE:
+35 ;---> BIX=text of the line to write.
+36 ;---> Write "YYYY Season" in left margin.
+37 IF '$GET(BIYEAR)
SET BIYEAR="YYYY"
+38 KILL BIX
NEW BIX
SET BIX=" "_+BIYEAR_" Season "
+39 SET BIX=$$PAD^BIUTL5(BIX,13)_"|"
+40 ;
+41 ;---> Now loop through the Age Groups, writing percentages.
+42 FOR BIAGRP=1:1:7
Begin DoDot:2
+43 ;---> BITMP(Vaccine Grp, CURRENT Season, Dose, Age Grp)
+44 NEW Y
SET Y=$GET(BITMP("STATS",BIVGRP,1,BIDOSE,BIAGRP))
IF Y=""
SET Y=0
+45 NEW Z
SET Z=$GET(BITMP("STATS","TOTAL",BIAGRP))
IF 'Z
SET Y=0
SET Z=1
+46 SET BIX=BIX_" "_$JUSTIFY((100*Y/Z),3,0)_"% "
End DoDot:2
+47 ;
+48 ;---> Now write total percentage.
+49 NEW Y
SET Y=BISUBT
IF Y=""
SET Y=0
+50 NEW Z
SET Z=$GET(BITMP("STATS","TOTAL","ALL"))
IF 'Z
SET Y=0
SET Z=1
+51 SET BIX=$$PAD^BIUTL5(BIX,69)_"| "_$JUSTIFY((100*Y/Z),3,0)_"%"
+52 DO WRITE(.BILINE,BIX)
+53 ;---> If H1N1, write final line (since we won't write a "Fully Immunized" row).
+54 IF BIVGRP=18
DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
End DoDot:1
+55 ;
+56 ;---> Do not write for H1N1 (since we won't write a "Fully Immunized" row).
+57 IF BIVGRP'=18
DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+58 QUIT
+59 ;
+60 ;
+61 ;----------
APPROP(BILINE) ;EP
+1 ;---> Write Appropriate for Age lines.
+2 ;---> Parameters:
+3 ; 1 - BILINE (req) Line number in ^TMP Listman array.
+4 ;
+5 ;---> Numbers of appropriate line.
+6 ;N BITOT,X S BITOT=0,X=" Appropriate |"
+7 NEW BITOT,X
SET BITOT=0
SET X=" Fully |"
+8 FOR BIAGRP=1:1:7
Begin DoDot:1
+9 NEW Y
SET Y=$GET(BITMP("STATS","APPRO",BIAGRP))
IF Y=""
SET Y=0
+10 ;---> Yes, now include Age Group 5 (18-49 High Risk) in Totals.
+11 ;S X=X_$J(Y,6)_" " S:(BIAGRP'=5) BITOT=BITOT+Y
+12 SET X=X_$JUSTIFY(Y,6)_" "
SET BITOT=BITOT+Y
End DoDot:1
+13 ;
+14 SET X=$EXTRACT(X,1,$LENGTH(X)-2)
SET X=$$PAD^BIUTL5(X,69)_"|"_$JUSTIFY(BITOT,7)
+15 DO WRITE(.BILINE,X)
+16 DO MARK^BIW(BILINE,3,"BIREPF1")
+17 ;
+18 ;---> Percentage of appropriate line.
+19 ;S X=" for Age |",BITOT=0
+20 SET X=" Immunized |"
SET BITOT=0
+21 FOR BIAGRP=1:1:7
Begin DoDot:1
+22 NEW Y
SET Y=$GET(BITMP("STATS","APPRO",BIAGRP))
IF Y=""
SET Y=0
+23 NEW Z
SET Z=$GET(BITMP("STATS","TOTAL",BIAGRP))
IF 'Z
SET Y=0
SET Z=1
+24 NEW BIPERC
SET BIPERC=" "_$JUSTIFY((100*Y/Z),3,0)_"%"
+25 SET X=X_BIPERC_" "
IF (BIAGRP'=5)
SET BITOT=BITOT+Y
End DoDot:1
+26 ;
+27 NEW Y
SET Y=BITOT
IF Y=""
SET Y=0
+28 NEW Z
SET Z=$GET(BITMP("STATS","TOTAL","ALL"))
IF 'Z
SET Y=0
SET Z=1
+29 ;S X=$E(X,1,$L(X)-2)_"| "_$J((100*Y/Z),3,0)_"%"
+30 SET X=$EXTRACT(X,1,$LENGTH(X)-1)
SET X=$$PAD^BIUTL5(X,69)_"| "_$JUSTIFY((100*Y/Z),3,0)_"%"
+31 DO WRITE(.BILINE,X)
+32 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+33 QUIT
+34 ;
+35 ;
+36 ;----------
WRITE(BILINE,BIVAL,BIBLNK) ;EP
+1 ;---> Write lines to ^TMP (see documentation in ^BIW).
+2 ;---> Parameters:
+3 ; 1 - BILINE (ret) Last line# written.
+4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
+5 ;
+6 IF '$DATA(BILINE)
QUIT
+7 DO WL^BIW(.BILINE,"BIREPF1",$GET(BIVAL),$GET(BIBLNK))
+8 QUIT
