BIREPQ3 ;IHS/CMI/MWR - REPORT, QUARTERLY IMM; OCT 15, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW QUARTERLY IMMUNIZATION REPORT.
;; PATCH 2: Fix header at 16-18mths to say 4-PCV. MNEED+24
;
;
;----------
AGETOT(BILINE,BICC,BIHCF,BICM,BIBEN,BIQDT,BIHPV,BIUP,BIPOP) ;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 - BIQDT (req) Quarter Ending Date.
; 7 - BIHPV (req) 1=include Hep A.
; 8 - BIUP (req) User Population/Group (Registered, Imm, User, Active).
; 9 - BIPOP (ret) BIPOP=1 if error.
;
S BIPOP=0
;---> Check for required Variables.
I '$G(BIQDT) D ERRCD^BIUTL2(623,.X) D WRITERR^BIREPQ2(BILINE,X) S BIPOP=1 Q
;
;---> Gather and sort patients.
N N S N=0
F I="3-4","5-6","7-15","16-18","19-23","24-27" D
.;---> For each age range, get Begin and End Dates (DOB's).
.D AGEDATE^BIAGE(I,BIQDT,.BIBEGDT,.BIENDDT)
.S N=N+1
.D GETPATS^BIREPQ4(BIBEGDT,BIENDDT,N,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIHPV,BIUP)
;
;---> Count patients.
N BIAGRP,BITOT S BITOT=0
F I=1:1:6 D
.N M,N S M=0,N=0,BIAGRP(I)=0
.F S N=$O(^TMP("BIREPQ1",$J,"PATS",I,N)) Q:'N D
..S BIAGRP(I)=BIAGRP(I)+1,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=" Age Total|"
F I=1:1:6 S X=X_$J(BIAGRP(I),7)_" "
S X=$E(X,1,$L(X)-2)_"|"_$J(BITOT,7)
D WRITE(.BILINE,X)
D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
Q
;
;
;----------
MNEED(BILINE,BIHPV) ;EP
;---> Write Minimum Needs lines.
;---> Parameters:
; 1 - BILINE (req) Line number in ^TMP Listman array.
; 2 - BIHPV (req) 1=Include Varicella & Pneumo.
;
S:'$D(BILINE) BILINE=0
S X=" Minimum | 1-DTaP 2-DTaP 3-DTaP 3-DTaP 4-DTaP"
S X=X_" 4-DTaP|"
D WRITE(.BILINE,X)
S X=" Needs | 1-POLIO 2-POLIO 2-POLIO 2-POLIO"
S X=X_" 3-POLIO 3-POLI|"
D WRITE(.BILINE,X)
S X=" | 1-HIB 2-HIB 2-HIB 3-HIB 3-HIB"
S X=X_" 3-HIB |"
D WRITE(.BILINE,X)
S X=" | 1-HEPB 2-HEPB 2-HEPB 2-HEPB 3-HEPB"
S X=X_" 3-HEPB|"
D WRITE(.BILINE,X)
D:$G(BIHPV)
.;
.;********** PATCH 2, v8.4, OCT 15,2010, IHS/CMI/MWR
.;---> Fix header at 16-18mths to say 4-PCV.
.;S X=" | 1-PCV 2-PCV 3-PCV 3-PCV "
.S X=" | 1-PCV 2-PCV 3-PCV 4-PCV "
.;**********
.;
.S X=X_" 4-PCV 4-PCV |"
.D WRITE(.BILINE,X)
;S X=" | 1-ROTA 2-ROTA 3-ROTA 3-ROTA 3-ROTA"
;S X=X_" 3-ROTA|"
;D WRITE(.BILINE,X)
S X=" | 1-MMR 1-MMR "
S X=X_" 1-MMR |"
D WRITE(.BILINE,X)
D:$G(BIHPV)
.S X=" | 1-VAR 1-VAR "
.S X=X_" 1-VAR |"
.D WRITE(.BILINE,X)
;D:$G(BIHPV) ;Never include Hep A.
;.S X=" | "
;.S X=X_" 1-HEPA|"
;.D WRITE(.BILINE,X)
D 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=" Approp. |"
F BIAGRP=1:1:6 D
.N Y S Y=$G(BITMP("STATS","APPRO",BIAGRP)) S:Y="" Y=0
.S X=X_$J(Y,7)_" ",BITOT=BITOT+Y
S X=$E(X,1,$L(X)-2)_"|"_$J(BITOT,7)
D WRITE(.BILINE,X)
D MARK^BIW(BILINE,3,"BIREPQ1")
;
;---> Percentage of appropriate line.
S X=" for Age |",BITOT=0
F BIAGRP=1:1:6 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_" ",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)_"%"
D WRITE(.BILINE,X)
D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
Q
;
;
;----------
VGRP(BILINE,BIVGRP) ;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.
;
;---> Write a line for each Dose of this Vaccine Group.
N BIDOSE,BIMAXD S BIMAXD=$$VGROUP^BIUTL2(BIVGRP,6)
N BIDOSE F BIDOSE=1:1:BIMAXD D
.;
.;---> 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,10)_"|"
.;
.;---> Now loop through the 6 age groups, concating subtotals.
.N BIAGRP,BISUBT S BISUBT=0
.F BIAGRP=1:1:6 D
..N Y S Y=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
..S BIX=BIX_$J(Y,7)_" ",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+1,"BIREPQ1")
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,"BIREPQ1",$G(BIVAL),$G(BIBLNK))
Q
BIREPQ3 ;IHS/CMI/MWR - REPORT, QUARTERLY IMM; OCT 15, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW QUARTERLY IMMUNIZATION REPORT.
+4 ;; PATCH 2: Fix header at 16-18mths to say 4-PCV. MNEED+24
+5 ;
+6 ;
+7 ;----------
AGETOT(BILINE,BICC,BIHCF,BICM,BIBEN,BIQDT,BIHPV,BIUP,BIPOP) ;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 - BIQDT (req) Quarter Ending Date.
+9 ; 7 - BIHPV (req) 1=include Hep A.
+10 ; 8 - BIUP (req) User Population/Group (Registered, Imm, User, Active).
+11 ; 9 - BIPOP (ret) BIPOP=1 if error.
+12 ;
+13 SET BIPOP=0
+14 ;---> Check for required Variables.
+15 IF '$GET(BIQDT)
DO ERRCD^BIUTL2(623,.X)
DO WRITERR^BIREPQ2(BILINE,X)
SET BIPOP=1
QUIT
+16 ;
+17 ;---> Gather and sort patients.
+18 NEW N
SET N=0
+19 FOR I="3-4","5-6","7-15","16-18","19-23","24-27"
Begin DoDot:1
+20 ;---> For each age range, get Begin and End Dates (DOB's).
+21 DO AGEDATE^BIAGE(I,BIQDT,.BIBEGDT,.BIENDDT)
+22 SET N=N+1
+23 DO GETPATS^BIREPQ4(BIBEGDT,BIENDDT,N,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIHPV,BIUP)
End DoDot:1
+24 ;
+25 ;---> Count patients.
+26 NEW BIAGRP,BITOT
SET BITOT=0
+27 FOR I=1:1:6
Begin DoDot:1
+28 NEW M,N
SET M=0
SET N=0
SET BIAGRP(I)=0
+29 FOR
SET N=$ORDER(^TMP("BIREPQ1",$JOB,"PATS",I,N))
IF 'N
QUIT
Begin DoDot:2
+30 SET BIAGRP(I)=BIAGRP(I)+1
SET BITOT=BITOT+1
End DoDot:2
+31 SET BITMP("STATS","TOTAL",I)=BIAGRP(I)
End DoDot:1
+32 SET BITMP("STATS","TOTAL","ALL")=BITOT
+33 ;
+34 ;---> Write Age Totals line.
+35 NEW X
SET X=" # in Age |"
+36 ;N X S X=" Age Total|"
+37 FOR I=1:1:6
SET X=X_$JUSTIFY(BIAGRP(I),7)_" "
+38 SET X=$EXTRACT(X,1,$LENGTH(X)-2)_"|"_$JUSTIFY(BITOT,7)
+39 DO WRITE(.BILINE,X)
+40 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+41 QUIT
+42 ;
+43 ;
+44 ;----------
MNEED(BILINE,BIHPV) ;EP
+1 ;---> Write Minimum Needs lines.
+2 ;---> Parameters:
+3 ; 1 - BILINE (req) Line number in ^TMP Listman array.
+4 ; 2 - BIHPV (req) 1=Include Varicella & Pneumo.
+5 ;
+6 IF '$DATA(BILINE)
SET BILINE=0
+7 SET X=" Minimum | 1-DTaP 2-DTaP 3-DTaP 3-DTaP 4-DTaP"
+8 SET X=X_" 4-DTaP|"
+9 DO WRITE(.BILINE,X)
+10 SET X=" Needs | 1-POLIO 2-POLIO 2-POLIO 2-POLIO"
+11 SET X=X_" 3-POLIO 3-POLI|"
+12 DO WRITE(.BILINE,X)
+13 SET X=" | 1-HIB 2-HIB 2-HIB 3-HIB 3-HIB"
+14 SET X=X_" 3-HIB |"
+15 DO WRITE(.BILINE,X)
+16 SET X=" | 1-HEPB 2-HEPB 2-HEPB 2-HEPB 3-HEPB"
+17 SET X=X_" 3-HEPB|"
+18 DO WRITE(.BILINE,X)
+19 IF $GET(BIHPV)
Begin DoDot:1
+20 ;
+21 ;********** PATCH 2, v8.4, OCT 15,2010, IHS/CMI/MWR
+22 ;---> Fix header at 16-18mths to say 4-PCV.
+23 ;S X=" | 1-PCV 2-PCV 3-PCV 3-PCV "
+24 SET X=" | 1-PCV 2-PCV 3-PCV 4-PCV "
+25 ;**********
+26 ;
+27 SET X=X_" 4-PCV 4-PCV |"
+28 DO WRITE(.BILINE,X)
End DoDot:1
+29 ;S X=" | 1-ROTA 2-ROTA 3-ROTA 3-ROTA 3-ROTA"
+30 ;S X=X_" 3-ROTA|"
+31 ;D WRITE(.BILINE,X)
+32 SET X=" | 1-MMR 1-MMR "
+33 SET X=X_" 1-MMR |"
+34 DO WRITE(.BILINE,X)
+35 IF $GET(BIHPV)
Begin DoDot:1
+36 SET X=" | 1-VAR 1-VAR "
+37 SET X=X_" 1-VAR |"
+38 DO WRITE(.BILINE,X)
End DoDot:1
+39 ;D:$G(BIHPV) ;Never include Hep A.
+40 ;.S X=" | "
+41 ;.S X=X_" 1-HEPA|"
+42 ;.D WRITE(.BILINE,X)
+43 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+44 QUIT
+45 ;
+46 ;
+47 ;----------
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 NEW BITOT,X
SET BITOT=0
SET X=" Approp. |"
+7 FOR BIAGRP=1:1:6
Begin DoDot:1
+8 NEW Y
SET Y=$GET(BITMP("STATS","APPRO",BIAGRP))
IF Y=""
SET Y=0
+9 SET X=X_$JUSTIFY(Y,7)_" "
SET BITOT=BITOT+Y
End DoDot:1
+10 SET X=$EXTRACT(X,1,$LENGTH(X)-2)_"|"_$JUSTIFY(BITOT,7)
+11 DO WRITE(.BILINE,X)
+12 DO MARK^BIW(BILINE,3,"BIREPQ1")
+13 ;
+14 ;---> Percentage of appropriate line.
+15 SET X=" for Age |"
SET BITOT=0
+16 FOR BIAGRP=1:1:6
Begin DoDot:1
+17 NEW Y
SET Y=$GET(BITMP("STATS","APPRO",BIAGRP))
IF Y=""
SET Y=0
+18 NEW Z
SET Z=$GET(BITMP("STATS","TOTAL",BIAGRP))
IF 'Z
SET Y=0
SET Z=1
+19 NEW BIPERC
SET BIPERC=" "_$JUSTIFY((100*Y/Z),3,0)_"%"
+20 SET X=X_BIPERC_" "
SET BITOT=BITOT+Y
End DoDot:1
+21 ;
+22 NEW Y
SET Y=BITOT
IF Y=""
SET Y=0
+23 NEW Z
SET Z=$GET(BITMP("STATS","TOTAL","ALL"))
IF 'Z
SET Y=0
SET Z=1
+24 SET X=$EXTRACT(X,1,$LENGTH(X)-2)_"| "_$JUSTIFY((100*Y/Z),3,0)_"%"
+25 DO WRITE(.BILINE,X)
+26 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+27 QUIT
+28 ;
+29 ;
+30 ;----------
VGRP(BILINE,BIVGRP) ;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 ;
+6 ;---> Write a line for each Dose of this Vaccine Group.
+7 NEW BIDOSE,BIMAXD
SET BIMAXD=$$VGROUP^BIUTL2(BIVGRP,6)
+8 NEW BIDOSE
FOR BIDOSE=1:1:BIMAXD
Begin DoDot:1
+9 ;
+10 ;---> BIX=text of the line to write.
+11 ;---> Write the Dose#-Vaccine Group in left margin.
+12 NEW BIX
SET BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)
+13 SET BIX=$$PAD^BIUTL5(BIX,10)_"|"
+14 ;
+15 ;---> Now loop through the 6 age groups, concating subtotals.
+16 NEW BIAGRP,BISUBT
SET BISUBT=0
+17 FOR BIAGRP=1:1:6
Begin DoDot:2
+18 NEW Y
SET Y=$GET(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
+19 SET BIX=BIX_$JUSTIFY(Y,7)_" "
SET BISUBT=BISUBT+Y
End DoDot:2
+20 ;
+21 SET BIX=$EXTRACT(BIX,1,$LENGTH(BIX)-2)_"|"_$JUSTIFY(BISUBT,7)
+22 DO WRITE(.BILINE,BIX)
+23 IF BIDOSE=1
DO MARK^BIW(BILINE,BIMAXD+1,"BIREPQ1")
End DoDot:1
+24 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+25 QUIT
+26 ;
+27 ;
+28 ;----------
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,"BIREPQ1",$GET(BIVAL),$GET(BIBLNK))
+8 QUIT
