BIREPE2 ;IHS/CMI/MWR - REPORT, VAC ELIGIBILITY; MAY 10, 2010
;;8.5;IMMUNIZATION;**2**;MAY 15,2012
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW OR PRINT VACCINE ELIGIBILITY REPORT.
;
;----------
HEAD(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT,BIU19) ;EP
;---> Produce Header array for Vaccine Accountability Report.
;---> Parameters:
; 1 - BIBEGDT (req) Begin date of report.
; 2 - BIENDDT (req) End date of report.
; 3 - BICC (req) Current Community array.
; 4 - BIHCF (req) Health Care Facility array.
; 5 - BICM (req) Case Manager array.
; 6 - BIBEN (req) Beneficiary Type array.
; 7 - BIHIST (req) Include Historical (1=yes,0=no).
; 8 - BIVT (req) Visit Type array.
; 9 - BIU19 (req) Include Adults parameter (1=yes,0=no).
;
;---> Check for required Variables.
Q:'$G(BIBEGDT)
Q:'$G(BIENDDT)
Q:'$D(BICC)
Q:'$D(BIHCF)
Q:'$D(BICM)
Q:'$D(BIBEN)
Q:'$D(BIHIST)
Q:'$D(BIVT)
Q:'$D(BIU19)
;
K VALMHDR
N BILINE,X S BILINE=0
;
N X S X=""
;---> If Header array is NOT being for Listmananger include version.
S:'$D(VALM("BM")) X=$$LMVER^BILOGO()
;
D WH^BIW(.BILINE,X)
S X=$$REPHDR^BIUTL6(DUZ(2)) D CENTERT^BIUTL5(.X)
D WH^BIW(.BILINE,X)
;
S X="* Vaccine Eligibility Report *" D CENTERT^BIUTL5(.X)
D WH^BIW(.BILINE,X)
;
;S X=$$TXDT1^BIUTL5(DT) D CENTERT^BIUTL5(.X)
;D WH^BIW(.BILINE,X,1)
;
S X=$$SP^BIUTL5(27)_"Report Date: "_$$SLDT1^BIUTL5(DT)
D WH^BIW(.BILINE,X)
;
S X=$$SP^BIUTL5(28)_"Date Range: "_$$SLDT1^BIUTL5(BIBEGDT)_" - "_$$SLDT1^BIUTL5(BIENDDT)
D WH^BIW(.BILINE,X,1)
;
S X=" (Historical "_$S(BIHIST:"In",1:"Ex")_"cluded"
S X=X_", Adults "_$S(BIU19:"In",1:"Ex")_"cluded)"
;
S X=X_$J("Total Immunizations: "_+$G(^TMP("BIDUL",$J,"TOTAL")),40)
D WH^BIW(.BILINE,X)
S X=$$SP^BIUTL5(79,"-")
D WH^BIW(.BILINE,X)
;
D
.;---> If specific Communities were selected (not ALL), then print
.;---> the Communities in a subheader at the top of the report.
.D SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR,,12)
.I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
.;
.;---> If specific Health Care Facilities, print subheader.
.D SUBH^BIOUTPT5("BIHCF","Facility",,"^DIC(4,",.BILINE,.BIERR,,12)
.I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
.;
.;---> If specific Case Managers, print Case Manager subheader.
.D SUBH^BIOUTPT5("BICM","Case Manager",,"^VA(200,",.BILINE,.BIERR,,12)
.I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
.;
.;---> If specific Beneficiary Types, print Beneficiary Type subheader.
.D SUBH^BIOUTPT5("BIBEN","Beneficiary Type",,"^AUTTBEN(",.BILINE,.BIERR,,12)
.I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
.;
.;---> If specific Visit Types, print Visit Type subheader.
.D SUBH^BIOUTPT5("BIVT","Visit Type",,"9000010-.03",.BILINE,.BIERR,,12)
.I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
.;
.S X=" Date Last,First Name DOB Eligibility Vaccine Lot#"
.;S X=X_"65+ TOTAL"
.D WH^BIW(.BILINE,X)
;
;---> If Header array is being built for Listmananger,
;---> reset display window margins for Communities, etc.
D:$D(VALM("BM"))
.S VALM("TM")=BILINE+3
.S VALM("LINES")=VALM("BM")-VALM("TM")+1
.;---> Safeguard to prevent divide/0 error.
.S:VALM("LINES")<1 VALM("LINES")=1
Q
;
;
;----------
GET(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT,BIU19,BIDELIM) ;EP
;----------
;---> Produce array for Vaccine Accountability Report.
;---> Parameters:
; 1 - BIBEGDT (req) Begin date of report.
; 2 - BIENDDT (req) End date of report.
; 3 - BICC (req) Current Community array.
; 4 - BIHCF (req) Health Care Facility array.
; 5 - BICM (req) Case Manager array.
; 6 - BIBEN (req) Beneficiary Type array.
; 7 - BIHIST (req) Include Historical (1=yes,0=no).
; 8 - BIVT (req) Visit Type array.
; 9 - BIU19 (req) Include Adults parameter (1=yes,0=no).
; 10 - BIDELIM (req) Deliniter (1="caret ^", 2="2 spaces").
;
; * NOT USED FOR NOW
; X - BIDLOT (req) If BIDLOT=1, display by Lot Numbers.
;
K ^TMP("BIREPE1",$J)
N BILINE,BITMP,X S BILINE=0
;
;---> Check for required Variables.
I '$G(BIBEGDT) D ERRCD^BIUTL2(626,.X) D WRITE(.BILINE,X) Q
I '$G(BIENDDT) D ERRCD^BIUTL2(627,.X) D WRITE(.BILINE,X) Q
I '$D(BICC) D ERRCD^BIUTL2(614,.X) D WRITE(.BILINE,X) Q
I '$D(BIHCF) D ERRCD^BIUTL2(625,.X) D WRITE(.BILINE,X) Q
I '$D(BICM) D ERRCD^BIUTL2(615,.X) D WRITE(.BILINE,X) Q
I '$D(BIBEN) D ERRCD^BIUTL2(662,.X) D WRITE(.BILINE,X) Q
I '$D(BIHIST) D ERRCD^BIUTL2(663,.X) D WRITE(.BILINE,X) Q
I '$D(BIVT) D ERRCD^BIUTL2(664,.X) D WRITE(.BILINE,X) Q
I '$D(BIU19) D ERRCD^BIUTL2(682,.X) D WRITE(.BILINE,X) Q
I '$D(BIDELIM) D ERRCD^BIUTL2(683,.X) D WRITE(.BILINE,X) Q
;I '$D(BIDLOT) D ERRCD^BIUTL2(681,.X) D WRITE(.BILINE,X) Q
;
;---> Gather data.
D GETIMMS^BIREPE3(BIBEGDT,BIENDDT,.BICC,.BIHCF,.BICM,.BIBEN,BIHIST,.BIVT,BIU19)
;
S BIDELIM=$S(BIDELIM=1:"^",1:" ")
N BILINE S BILINE=0
;S ^TMP("BIDUL",$J,BIDATE,BINAME,BIIIEN)=BIVAL
N BIDATE S BIDATE=0
F S BIDATE=$O(^TMP("BIDUL",$J,BIDATE)) Q:'BIDATE D
.N BINAME S BINAME=""
.F S BINAME=$O(^TMP("BIDUL",$J,BIDATE,BINAME)) Q:(BINAME="") D
..N BIIIEN S BIIIEN=0
..F S BIIIEN=$O(^TMP("BIDUL",$J,BIDATE,BINAME,BIIIEN)) Q:'BIIIEN D
...N W,X,Y,Z S Y=^TMP("BIDUL",$J,BIDATE,BINAME,BIIIEN)
...S Z=BIDELIM S X=$S(Z=" ":" ",1:"")
...;S X=X_$P(Y,U)_Z_$$PAD^BIUTL5($E($P(Y,U,2),1,14),14)_Z_$P(Y,U,3)
...;S X=X_Z_$$PAD^BIUTL5($P(Y,U,4),9)_Z_$$PAD^BIUTL5($P(Y,U,5),10)_Z_$P(Y,U,6)
...;
...S X=X_$P(Y,U)_Z
...S W=$E($P(Y,U,2),1,14) I Z'="^" S W=$$PAD^BIUTL5(W,14)
...S X=X_W_Z_$P(Y,U,3)_Z
...S W=$P(Y,U,4) I Z'="^" S W=$$PAD^BIUTL5(W,9)
...S X=X_W_Z
...S W=$P(Y,U,5) I Z'="^" S W=$$PAD^BIUTL5(W,10)
...S X=X_W_Z_$P(Y,U,6)
...;;
...;S X=X_Z_$$PAD^BIUTL5($P(Y,U,4),9)_Z_$$PAD^BIUTL5($P(Y,U,5),10)_Z_$P(Y,U,6)
...D WRITE(.BILINE,X)
;
;---> Set final VALMCNT (Listman line count).
S VALMCNT=BILINE
Q
;
;*** NOT USED ***
;---> Write Stats lines for each Vaccine Group.
;---> BIG=Vaccine Group, BIV=Vaccine Name, BIA=Age.
N BILINE S BILINE=0
N BIG S BIG=0
F S BIG=$O(BITMP("STATS",BIG)) Q:'BIG D
.N BIV S BIV=0
.F S BIV=$O(BITMP("STATS",BIG,BIV)) Q:BIV="" D
..;
..N BILSAV,X
..;
..;---> Write Vaccine Name line.
..S X=BIV
..I $G(BIDLOT) S X=X_" - All Lots"
..D CENTERT^BIUTL5(.X)
..;---> Save this line# for marking as a single record to print.
..D WRITE(.BILINE,X) S BILSAV=BILINE
..;
..;---> Build Age Totals line for this vaccine.
..;S X=$$SUML() D WRITE(.BILINE,X)
..S X="" N BIA
..F BIA=1:1:12 S X=X_$J($G(BITMP("STATS",BIG,BIV,"ALL",BIA)),6)
..;---> Now concat Total column (for this vaccine row).
..S X=X_$J($G(BITMP("STATS",BIG,BIV,"ALL","TOTAL")),7)
..D WRITE(.BILINE,X)
..D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
..;---> Now mark the top line of this vaccine to print as one record.
..D:$G(BILSAV) MARK^BIW(BILSAV,BILINE-BILSAV,"BIREPE1")
..;
..Q:'$G(BIDLOT)
..;---> Display rows by individual Lot Number.
..N BIL S BIL=0
..F S BIL=$O(BITMP("STATS",BIG,BIV,BIL)) Q:BIL="" D
...Q:(BIL="ALL")
...;---> Write Vaccine Name with Lot Number concatenated.
...S X=BIV_" - "_BIL D CENTERT^BIUTL5(.X)
...D WRITE(.BILINE,X) S BILSAV=BILINE
...;S X=$$SUML() D WRITE(.BILINE,X)
...S X="" N BIA
...F BIA=1:1:12 S X=X_$J($G(BITMP("STATS",BIG,BIV,BIL,BIA)),6)
...S X=X_$J($G(BITMP("STATS",BIG,BIV,BIL,"TOTAL")),7)
...D WRITE(.BILINE,X)
...D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
...D:$G(BILSAV) MARK^BIW(BILSAV,BILINE-BILSAV,"BIREPE1")
...;
...;---> Now mark the top line of this vaccine to print as one record.
...D:$G(BILSAV) MARK^BIW(BILSAV,BILINE-BILSAV,"BIREPE1")
;
;---> Now write total in .
S X=" TOTAL IMMUNIZATIONS (for all vaccines in this report)"
S X=X_$$SP^BIUTL5(16)_$J(+$G(BITMP("STATS","ALL","TOTAL")),9)
D WRITE(.BILINE,X),WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
;
;---> Now write total patients considered who had refusals.
;---> Not desired on this report, per Ros 10-12-05
;N M,N S (M,N)=0 F S M=$O(BITMP("REFUSALS",M)) Q:'M S N=N+1
;S X=" Total Patients included who had Refusals on record"_$J(N,28)
;D WRITE(.BILINE,X),WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
;
;---> Set final VALMCNT (Listman line count).
S VALMCNT=BILINE
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,"BIREPE1",$G(BIVAL),$G(BIBLNK))
;
;--->Set VALMCNT (Listman line count) for errors calls above.
S VALMCNT=BILINE
Q
BIREPE2 ;IHS/CMI/MWR - REPORT, VAC ELIGIBILITY; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**2**;MAY 15,2012
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW OR PRINT VACCINE ELIGIBILITY REPORT.
+4 ;
+5 ;----------
HEAD(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT,BIU19) ;EP
+1 ;---> Produce Header array for Vaccine Accountability Report.
+2 ;---> Parameters:
+3 ; 1 - BIBEGDT (req) Begin date of report.
+4 ; 2 - BIENDDT (req) End date of report.
+5 ; 3 - BICC (req) Current Community array.
+6 ; 4 - BIHCF (req) Health Care Facility array.
+7 ; 5 - BICM (req) Case Manager array.
+8 ; 6 - BIBEN (req) Beneficiary Type array.
+9 ; 7 - BIHIST (req) Include Historical (1=yes,0=no).
+10 ; 8 - BIVT (req) Visit Type array.
+11 ; 9 - BIU19 (req) Include Adults parameter (1=yes,0=no).
+12 ;
+13 ;---> Check for required Variables.
+14 IF '$GET(BIBEGDT)
QUIT
+15 IF '$GET(BIENDDT)
QUIT
+16 IF '$DATA(BICC)
QUIT
+17 IF '$DATA(BIHCF)
QUIT
+18 IF '$DATA(BICM)
QUIT
+19 IF '$DATA(BIBEN)
QUIT
+20 IF '$DATA(BIHIST)
QUIT
+21 IF '$DATA(BIVT)
QUIT
+22 IF '$DATA(BIU19)
QUIT
+23 ;
+24 KILL VALMHDR
+25 NEW BILINE,X
SET BILINE=0
+26 ;
+27 NEW X
SET X=""
+28 ;---> If Header array is NOT being for Listmananger include version.
+29 IF '$DATA(VALM("BM"))
SET X=$$LMVER^BILOGO()
+30 ;
+31 DO WH^BIW(.BILINE,X)
+32 SET X=$$REPHDR^BIUTL6(DUZ(2))
DO CENTERT^BIUTL5(.X)
+33 DO WH^BIW(.BILINE,X)
+34 ;
+35 SET X="* Vaccine Eligibility Report *"
DO CENTERT^BIUTL5(.X)
+36 DO WH^BIW(.BILINE,X)
+37 ;
+38 ;S X=$$TXDT1^BIUTL5(DT) D CENTERT^BIUTL5(.X)
+39 ;D WH^BIW(.BILINE,X,1)
+40 ;
+41 SET X=$$SP^BIUTL5(27)_"Report Date: "_$$SLDT1^BIUTL5(DT)
+42 DO WH^BIW(.BILINE,X)
+43 ;
+44 SET X=$$SP^BIUTL5(28)_"Date Range: "_$$SLDT1^BIUTL5(BIBEGDT)_" - "_$$SLDT1^BIUTL5(BIENDDT)
+45 DO WH^BIW(.BILINE,X,1)
+46 ;
+47 SET X=" (Historical "_$SELECT(BIHIST:"In",1:"Ex")_"cluded"
+48 SET X=X_", Adults "_$SELECT(BIU19:"In",1:"Ex")_"cluded)"
+49 ;
+50 SET X=X_$JUSTIFY("Total Immunizations: "_+$GET(^TMP("BIDUL",$JOB,"TOTAL")),40)
+51 DO WH^BIW(.BILINE,X)
+52 SET X=$$SP^BIUTL5(79,"-")
+53 DO WH^BIW(.BILINE,X)
+54 ;
+55 Begin DoDot:1
+56 ;---> If specific Communities were selected (not ALL), then print
+57 ;---> the Communities in a subheader at the top of the report.
+58 DO SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR,,12)
+59 IF $GET(BIERR)
DO ERRCD^BIUTL2(BIERR,.X)
DO WH^BIW(.BILINE,X)
QUIT
+60 ;
+61 ;---> If specific Health Care Facilities, print subheader.
+62 DO SUBH^BIOUTPT5("BIHCF","Facility",,"^DIC(4,",.BILINE,.BIERR,,12)
+63 IF $GET(BIERR)
DO ERRCD^BIUTL2(BIERR,.X)
DO WH^BIW(.BILINE,X)
QUIT
+64 ;
+65 ;---> If specific Case Managers, print Case Manager subheader.
+66 DO SUBH^BIOUTPT5("BICM","Case Manager",,"^VA(200,",.BILINE,.BIERR,,12)
+67 IF $GET(BIERR)
DO ERRCD^BIUTL2(BIERR,.X)
DO WH^BIW(.BILINE,X)
QUIT
+68 ;
+69 ;---> If specific Beneficiary Types, print Beneficiary Type subheader.
+70 DO SUBH^BIOUTPT5("BIBEN","Beneficiary Type",,"^AUTTBEN(",.BILINE,.BIERR,,12)
+71 IF $GET(BIERR)
DO ERRCD^BIUTL2(BIERR,.X)
DO WH^BIW(.BILINE,X)
QUIT
+72 ;
+73 ;---> If specific Visit Types, print Visit Type subheader.
+74 DO SUBH^BIOUTPT5("BIVT","Visit Type",,"9000010-.03",.BILINE,.BIERR,,12)
+75 IF $GET(BIERR)
DO ERRCD^BIUTL2(BIERR,.X)
DO WH^BIW(.BILINE,X)
QUIT
+76 ;
+77 SET X=" Date Last,First Name DOB Eligibility Vaccine Lot#"
+78 ;S X=X_"65+ TOTAL"
+79 DO WH^BIW(.BILINE,X)
End DoDot:1
+80 ;
+81 ;---> If Header array is being built for Listmananger,
+82 ;---> reset display window margins for Communities, etc.
+83 IF $DATA(VALM("BM"))
Begin DoDot:1
+84 SET VALM("TM")=BILINE+3
+85 SET VALM("LINES")=VALM("BM")-VALM("TM")+1
+86 ;---> Safeguard to prevent divide/0 error.
+87 IF VALM("LINES")<1
SET VALM("LINES")=1
End DoDot:1
+88 QUIT
+89 ;
+90 ;
+91 ;----------
GET(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT,BIU19,BIDELIM) ;EP
+1 ;----------
+2 ;---> Produce array for Vaccine Accountability Report.
+3 ;---> Parameters:
+4 ; 1 - BIBEGDT (req) Begin date of report.
+5 ; 2 - BIENDDT (req) End date of report.
+6 ; 3 - BICC (req) Current Community array.
+7 ; 4 - BIHCF (req) Health Care Facility array.
+8 ; 5 - BICM (req) Case Manager array.
+9 ; 6 - BIBEN (req) Beneficiary Type array.
+10 ; 7 - BIHIST (req) Include Historical (1=yes,0=no).
+11 ; 8 - BIVT (req) Visit Type array.
+12 ; 9 - BIU19 (req) Include Adults parameter (1=yes,0=no).
+13 ; 10 - BIDELIM (req) Deliniter (1="caret ^", 2="2 spaces").
+14 ;
+15 ; * NOT USED FOR NOW
+16 ; X - BIDLOT (req) If BIDLOT=1, display by Lot Numbers.
+17 ;
+18 KILL ^TMP("BIREPE1",$JOB)
+19 NEW BILINE,BITMP,X
SET BILINE=0
+20 ;
+21 ;---> Check for required Variables.
+22 IF '$GET(BIBEGDT)
DO ERRCD^BIUTL2(626,.X)
DO WRITE(.BILINE,X)
QUIT
+23 IF '$GET(BIENDDT)
DO ERRCD^BIUTL2(627,.X)
DO WRITE(.BILINE,X)
QUIT
+24 IF '$DATA(BICC)
DO ERRCD^BIUTL2(614,.X)
DO WRITE(.BILINE,X)
QUIT
+25 IF '$DATA(BIHCF)
DO ERRCD^BIUTL2(625,.X)
DO WRITE(.BILINE,X)
QUIT
+26 IF '$DATA(BICM)
DO ERRCD^BIUTL2(615,.X)
DO WRITE(.BILINE,X)
QUIT
+27 IF '$DATA(BIBEN)
DO ERRCD^BIUTL2(662,.X)
DO WRITE(.BILINE,X)
QUIT
+28 IF '$DATA(BIHIST)
DO ERRCD^BIUTL2(663,.X)
DO WRITE(.BILINE,X)
QUIT
+29 IF '$DATA(BIVT)
DO ERRCD^BIUTL2(664,.X)
DO WRITE(.BILINE,X)
QUIT
+30 IF '$DATA(BIU19)
DO ERRCD^BIUTL2(682,.X)
DO WRITE(.BILINE,X)
QUIT
+31 IF '$DATA(BIDELIM)
DO ERRCD^BIUTL2(683,.X)
DO WRITE(.BILINE,X)
QUIT
+32 ;I '$D(BIDLOT) D ERRCD^BIUTL2(681,.X) D WRITE(.BILINE,X) Q
+33 ;
+34 ;---> Gather data.
+35 DO GETIMMS^BIREPE3(BIBEGDT,BIENDDT,.BICC,.BIHCF,.BICM,.BIBEN,BIHIST,.BIVT,BIU19)
+36 ;
+37 SET BIDELIM=$SELECT(BIDELIM=1:"^",1:" ")
+38 NEW BILINE
SET BILINE=0
+39 ;S ^TMP("BIDUL",$J,BIDATE,BINAME,BIIIEN)=BIVAL
+40 NEW BIDATE
SET BIDATE=0
+41 FOR
SET BIDATE=$ORDER(^TMP("BIDUL",$JOB,BIDATE))
IF 'BIDATE
QUIT
Begin DoDot:1
+42 NEW BINAME
SET BINAME=""
+43 FOR
SET BINAME=$ORDER(^TMP("BIDUL",$JOB,BIDATE,BINAME))
IF (BINAME="")
QUIT
Begin DoDot:2
+44 NEW BIIIEN
SET BIIIEN=0
+45 FOR
SET BIIIEN=$ORDER(^TMP("BIDUL",$JOB,BIDATE,BINAME,BIIIEN))
IF 'BIIIEN
QUIT
Begin DoDot:3
+46 NEW W,X,Y,Z
SET Y=^TMP("BIDUL",$JOB,BIDATE,BINAME,BIIIEN)
+47 SET Z=BIDELIM
SET X=$SELECT(Z=" ":" ",1:"")
+48 ;S X=X_$P(Y,U)_Z_$$PAD^BIUTL5($E($P(Y,U,2),1,14),14)_Z_$P(Y,U,3)
+49 ;S X=X_Z_$$PAD^BIUTL5($P(Y,U,4),9)_Z_$$PAD^BIUTL5($P(Y,U,5),10)_Z_$P(Y,U,6)
+50 ;
+51 SET X=X_$PIECE(Y,U)_Z
+52 SET W=$EXTRACT($PIECE(Y,U,2),1,14)
IF Z'="^"
SET W=$$PAD^BIUTL5(W,14)
+53 SET X=X_W_Z_$PIECE(Y,U,3)_Z
+54 SET W=$PIECE(Y,U,4)
IF Z'="^"
SET W=$$PAD^BIUTL5(W,9)
+55 SET X=X_W_Z
+56 SET W=$PIECE(Y,U,5)
IF Z'="^"
SET W=$$PAD^BIUTL5(W,10)
+57 SET X=X_W_Z_$PIECE(Y,U,6)
+58 ;;
+59 ;S X=X_Z_$$PAD^BIUTL5($P(Y,U,4),9)_Z_$$PAD^BIUTL5($P(Y,U,5),10)_Z_$P(Y,U,6)
+60 DO WRITE(.BILINE,X)
End DoDot:3
End DoDot:2
End DoDot:1
+61 ;
+62 ;---> Set final VALMCNT (Listman line count).
+63 SET VALMCNT=BILINE
+64 QUIT
+65 ;
+66 ;*** NOT USED ***
+67 ;---> Write Stats lines for each Vaccine Group.
+68 ;---> BIG=Vaccine Group, BIV=Vaccine Name, BIA=Age.
+69 NEW BILINE
SET BILINE=0
+70 NEW BIG
SET BIG=0
+71 FOR
SET BIG=$ORDER(BITMP("STATS",BIG))
IF 'BIG
QUIT
Begin DoDot:1
+72 NEW BIV
SET BIV=0
+73 FOR
SET BIV=$ORDER(BITMP("STATS",BIG,BIV))
IF BIV=""
QUIT
Begin DoDot:2
+74 ;
+75 NEW BILSAV,X
+76 ;
+77 ;---> Write Vaccine Name line.
+78 SET X=BIV
+79 IF $GET(BIDLOT)
SET X=X_" - All Lots"
+80 DO CENTERT^BIUTL5(.X)
+81 ;---> Save this line# for marking as a single record to print.
+82 DO WRITE(.BILINE,X)
SET BILSAV=BILINE
+83 ;
+84 ;---> Build Age Totals line for this vaccine.
+85 ;S X=$$SUML() D WRITE(.BILINE,X)
+86 SET X=""
NEW BIA
+87 FOR BIA=1:1:12
SET X=X_$JUSTIFY($GET(BITMP("STATS",BIG,BIV,"ALL",BIA)),6)
+88 ;---> Now concat Total column (for this vaccine row).
+89 SET X=X_$JUSTIFY($GET(BITMP("STATS",BIG,BIV,"ALL","TOTAL")),7)
+90 DO WRITE(.BILINE,X)
+91 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+92 ;---> Now mark the top line of this vaccine to print as one record.
+93 IF $GET(BILSAV)
DO MARK^BIW(BILSAV,BILINE-BILSAV,"BIREPE1")
+94 ;
+95 IF '$GET(BIDLOT)
QUIT
+96 ;---> Display rows by individual Lot Number.
+97 NEW BIL
SET BIL=0
+98 FOR
SET BIL=$ORDER(BITMP("STATS",BIG,BIV,BIL))
IF BIL=""
QUIT
Begin DoDot:3
+99 IF (BIL="ALL")
QUIT
+100 ;---> Write Vaccine Name with Lot Number concatenated.
+101 SET X=BIV_" - "_BIL
DO CENTERT^BIUTL5(.X)
+102 DO WRITE(.BILINE,X)
SET BILSAV=BILINE
+103 ;S X=$$SUML() D WRITE(.BILINE,X)
+104 SET X=""
NEW BIA
+105 FOR BIA=1:1:12
SET X=X_$JUSTIFY($GET(BITMP("STATS",BIG,BIV,BIL,BIA)),6)
+106 SET X=X_$JUSTIFY($GET(BITMP("STATS",BIG,BIV,BIL,"TOTAL")),7)
+107 DO WRITE(.BILINE,X)
+108 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+109 IF $GET(BILSAV)
DO MARK^BIW(BILSAV,BILINE-BILSAV,"BIREPE1")
+110 ;
+111 ;---> Now mark the top line of this vaccine to print as one record.
+112 IF $GET(BILSAV)
DO MARK^BIW(BILSAV,BILINE-BILSAV,"BIREPE1")
End DoDot:3
End DoDot:2
End DoDot:1
+113 ;
+114 ;---> Now write total in .
+115 SET X=" TOTAL IMMUNIZATIONS (for all vaccines in this report)"
+116 SET X=X_$$SP^BIUTL5(16)_$JUSTIFY(+$GET(BITMP("STATS","ALL","TOTAL")),9)
+117 DO WRITE(.BILINE,X)
DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+118 ;
+119 ;---> Now write total patients considered who had refusals.
+120 ;---> Not desired on this report, per Ros 10-12-05
+121 ;N M,N S (M,N)=0 F S M=$O(BITMP("REFUSALS",M)) Q:'M S N=N+1
+122 ;S X=" Total Patients included who had Refusals on record"_$J(N,28)
+123 ;D WRITE(.BILINE,X),WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+124 ;
+125 ;---> Set final VALMCNT (Listman line count).
+126 SET VALMCNT=BILINE
+127 QUIT
+128 ;
+129 ;
+130 ;----------
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,"BIREPE1",$GET(BIVAL),$GET(BIBLNK))
+8 ;
+9 ;--->Set VALMCNT (Listman line count) for errors calls above.
+10 SET VALMCNT=BILINE
+11 QUIT
