BIREPH2 ;IHS/CMI/MWR - REPORT, H1N1 ACCOUNTABILITY; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW OR PRINT H1N1 ACCOUNTABILITY REPORT.
;; PATCH 3: BIREPH* routines are completely new for H1N1 Report.
;
;----------
HEAD(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT) ;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.
;
;---> 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)
;
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="* H1N1 Accountability Report *" D CENTERT^BIUTL5(.X)
D WH^BIW(.BILINE,X)
;
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)"
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 Beneficiary Types, print Beneficiary 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=" Dose | 6-23m 24-59m 5-18y 19-24y 25-49y 50-64y "
.S X=X_" 65+y | TOTAL"
.D WH^BIW(.BILINE,X)
.;S X=$$SUML(" Dose")
.;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) ;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.
;
K ^TMP("BIREPH1",$J),^TMP("BIDFN",$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
;
;---> Gather data.
D GETIMMS^BIREPH3(BIBEGDT,BIENDDT,.BICC,.BIHCF,.BICM,.BIBEN,BIHIST,.BIVT)
;
;---> Write Stats lines for each Vaccine Group.
;---> BIG=Vaccine Group, BIV=Vaccine Name, BIA=Age.
;
N BILINE S BILINE=0
N BIDATE S BIDATE=0
F S BIDATE=$O(BITMP("STATS",BIDATE)) Q:'BIDATE D
.;---> S BIDATEX=External Date format of BIDATE
.N BIDATEX,BILSAV D
..N Y S Y=BIDATE D DD^%DT S BIDATEX=" "_$P(Y,",")
.;---> Write Date line.
.S X=$$SUML(BIDATEX) D WRITE(.BILINE,X) S BILSAV=BILINE
.;
.N BIDOSE
.F BIDOSE=1:1:2 D
..;---> Write Dose line.
..;S X=BIDOSE 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 date & dose.
..;I BIDOSE>1 S X=$$SUML(BIDATEX) D WRITE(.BILINE,X) ;S BILSAV=BILINE
..N X S X=" #"_BIDOSE_" |" N BIA
..F BIA=1:1:6 S X=X_$J($G(BITMP("STATS",BIDATE,BIDOSE,"AGE",BIA)),7,0)_" "
..;---> Last line special just to concat "|".
..S X=X_$J($G(BITMP("STATS",BIDATE,BIDOSE,"AGE",7)),7,0)_" |"
..;
..;---> Now concat Total column (for this dose).
..S X=X_$J($G(BITMP("STATS",BIDATE,BIDOSE,"TOTAL")),7,0)
..D WRITE(.BILINE,X) I BIDOSE=1 S BILSAV=BILINE
.;
.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,"BIREPH1")
;
;---> Now write totals.
S X=" Total H1N1 First Doses"
S X=X_$$SP^BIUTL5(48)_"|"_$J(+$G(BITMP("STATS","DOSES",1,"TOTAL")),7,0)
D WRITE(.BILINE,X)
;
S X=" Total H1N1 Second Doses"
S X=X_$$SP^BIUTL5(47)_"|"_$J(+$G(BITMP("STATS","DOSES",2,"TOTAL")),7,0)
D WRITE(.BILINE,X),WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
;
S X=" Total H1N1 Immunizations"
S X=X_$$SP^BIUTL5(46)_"|"_$J(+$G(BITMP("STATS","ALL","TOTAL")),7,0)
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,"BIREPH1",$G(BIVAL),$G(BIBLNK))
;
;--->Set VALMCNT (Listman line count) for errors calls above.
S VALMCNT=BILINE
Q
;
;
;----------
SUML(Y) ;EP
;---> Produce Header array for Vaccine Accountability Report.
;---> Parameters:
; 1 - Y (opt) Y=text, such as Date (Aug 23) or "Dose" or other text.
I $L($G(Y))=0 S Y=" "
S Y=$E(Y,1,7) S Y=$$PAD^BIUTL5(Y,7)
N X
S X=Y_" | |"
; " Date | 6-23m 24-59m 5-18y 19-25y 25-49y 50-64y "
;S X=Y_" | ------ ------ ------ ------ ------ ------ --"
; "65+y TOTAL"
;Q X_"---- | ------"
Q X
BIREPH2 ;IHS/CMI/MWR - REPORT, H1N1 ACCOUNTABILITY; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW OR PRINT H1N1 ACCOUNTABILITY REPORT.
+4 ;; PATCH 3: BIREPH* routines are completely new for H1N1 Report.
+5 ;
+6 ;----------
HEAD(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT) ;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 ;
+12 ;---> Check for required Variables.
+13 IF '$GET(BIBEGDT)
QUIT
+14 IF '$GET(BIENDDT)
QUIT
+15 IF '$DATA(BICC)
QUIT
+16 IF '$DATA(BIHCF)
QUIT
+17 IF '$DATA(BICM)
QUIT
+18 IF '$DATA(BIBEN)
QUIT
+19 IF '$DATA(BIHIST)
QUIT
+20 IF '$DATA(BIVT)
QUIT
+21 ;
+22 KILL VALMHDR
+23 NEW BILINE,X
SET BILINE=0
+24 ;
+25 NEW X
SET X=""
+26 ;---> If Header array is NOT being for Listmananger include version.
+27 IF '$DATA(VALM("BM"))
SET X=$$LMVER^BILOGO()
+28 ;
+29 DO WH^BIW(.BILINE,X)
+30 SET X=$$REPHDR^BIUTL6(DUZ(2))
DO CENTERT^BIUTL5(.X)
+31 DO WH^BIW(.BILINE,X)
+32 ;
+33 SET X="* H1N1 Accountability Report *"
DO CENTERT^BIUTL5(.X)
+34 DO WH^BIW(.BILINE,X)
+35 ;
+36 SET X=$$SP^BIUTL5(27)_"Report Date: "_$$SLDT1^BIUTL5(DT)
+37 DO WH^BIW(.BILINE,X)
+38 ;
+39 SET X=$$SP^BIUTL5(28)_"Date Range: "_$$SLDT1^BIUTL5(BIBEGDT)_" - "_$$SLDT1^BIUTL5(BIENDDT)
+40 DO WH^BIW(.BILINE,X,1)
+41 ;
+42 SET X=" (Historical "_$SELECT(BIHIST:"In",1:"Ex")_"cluded)"
+43 DO WH^BIW(.BILINE,X)
+44 SET X=$$SP^BIUTL5(79,"-")
+45 DO WH^BIW(.BILINE,X)
+46 ;
+47 Begin DoDot:1
+48 ;---> If specific Communities were selected (not ALL), then print
+49 ;---> the Communities in a subheader at the top of the report.
+50 DO SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR,,12)
+51 IF $GET(BIERR)
DO ERRCD^BIUTL2(BIERR,.X)
DO WH^BIW(.BILINE,X)
QUIT
+52 ;
+53 ;---> If specific Health Care Facilities, print subheader.
+54 DO SUBH^BIOUTPT5("BIHCF","Facility",,"^DIC(4,",.BILINE,.BIERR,,12)
+55 IF $GET(BIERR)
DO ERRCD^BIUTL2(BIERR,.X)
DO WH^BIW(.BILINE,X)
QUIT
+56 ;
+57 ;---> If specific Case Managers, print Case Manager subheader.
+58 DO SUBH^BIOUTPT5("BICM","Case Manager",,"^VA(200,",.BILINE,.BIERR,,12)
+59 IF $GET(BIERR)
DO ERRCD^BIUTL2(BIERR,.X)
DO WH^BIW(.BILINE,X)
QUIT
+60 ;
+61 ;---> If specific Beneficiary Types, print Beneficiary Type subheader.
+62 DO SUBH^BIOUTPT5("BIBEN","Beneficiary Type",,"^AUTTBEN(",.BILINE,.BIERR,,12)
+63 IF $GET(BIERR)
DO ERRCD^BIUTL2(BIERR,.X)
DO WH^BIW(.BILINE,X)
QUIT
+64 ;
+65 ;---> If specific Beneficiary Types, print Beneficiary Type subheader.
+66 DO SUBH^BIOUTPT5("BIVT","Visit Type",,"9000010-.03",.BILINE,.BIERR,,12)
+67 IF $GET(BIERR)
DO ERRCD^BIUTL2(BIERR,.X)
DO WH^BIW(.BILINE,X)
QUIT
+68 ;
+69 SET X=" Dose | 6-23m 24-59m 5-18y 19-24y 25-49y 50-64y "
+70 SET X=X_" 65+y | TOTAL"
+71 DO WH^BIW(.BILINE,X)
+72 ;S X=$$SUML(" Dose")
+73 ;D WH^BIW(.BILINE,X)
End DoDot:1
+74 ;
+75 ;---> If Header array is being built for Listmananger,
+76 ;---> reset display window margins for Communities, etc.
+77 IF $DATA(VALM("BM"))
Begin DoDot:1
+78 SET VALM("TM")=BILINE+3
+79 SET VALM("LINES")=VALM("BM")-VALM("TM")+1
+80 ;---> Safeguard to prevent divide/0 error.
+81 IF VALM("LINES")<1
SET VALM("LINES")=1
End DoDot:1
+82 QUIT
+83 ;
+84 ;
+85 ;----------
GET(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT) ;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 ;
+13 KILL ^TMP("BIREPH1",$JOB),^TMP("BIDFN",$JOB)
+14 NEW BILINE,BITMP,X
SET BILINE=0
+15 ;
+16 ;---> Check for required Variables.
+17 IF '$GET(BIBEGDT)
DO ERRCD^BIUTL2(626,.X)
DO WRITE(.BILINE,X)
QUIT
+18 IF '$GET(BIENDDT)
DO ERRCD^BIUTL2(627,.X)
DO WRITE(.BILINE,X)
QUIT
+19 IF '$DATA(BICC)
DO ERRCD^BIUTL2(614,.X)
DO WRITE(.BILINE,X)
QUIT
+20 IF '$DATA(BIHCF)
DO ERRCD^BIUTL2(625,.X)
DO WRITE(.BILINE,X)
QUIT
+21 IF '$DATA(BICM)
DO ERRCD^BIUTL2(615,.X)
DO WRITE(.BILINE,X)
QUIT
+22 IF '$DATA(BIBEN)
DO ERRCD^BIUTL2(662,.X)
DO WRITE(.BILINE,X)
QUIT
+23 IF '$DATA(BIHIST)
DO ERRCD^BIUTL2(663,.X)
DO WRITE(.BILINE,X)
QUIT
+24 IF '$DATA(BIVT)
DO ERRCD^BIUTL2(664,.X)
DO WRITE(.BILINE,X)
QUIT
+25 ;
+26 ;---> Gather data.
+27 DO GETIMMS^BIREPH3(BIBEGDT,BIENDDT,.BICC,.BIHCF,.BICM,.BIBEN,BIHIST,.BIVT)
+28 ;
+29 ;---> Write Stats lines for each Vaccine Group.
+30 ;---> BIG=Vaccine Group, BIV=Vaccine Name, BIA=Age.
+31 ;
+32 NEW BILINE
SET BILINE=0
+33 NEW BIDATE
SET BIDATE=0
+34 FOR
SET BIDATE=$ORDER(BITMP("STATS",BIDATE))
IF 'BIDATE
QUIT
Begin DoDot:1
+35 ;---> S BIDATEX=External Date format of BIDATE
+36 NEW BIDATEX,BILSAV
Begin DoDot:2
+37 NEW Y
SET Y=BIDATE
DO DD^%DT
SET BIDATEX=" "_$PIECE(Y,",")
End DoDot:2
+38 ;---> Write Date line.
+39 SET X=$$SUML(BIDATEX)
DO WRITE(.BILINE,X)
SET BILSAV=BILINE
+40 ;
+41 NEW BIDOSE
+42 FOR BIDOSE=1:1:2
Begin DoDot:2
+43 ;---> Write Dose line.
+44 ;S X=BIDOSE D CENTERT^BIUTL5(.X)
+45 ;---> Save this line# for marking as a single record to print.
+46 ;D WRITE(.BILINE,X) S BILSAV=BILINE
+47 ;
+48 ;---> Build Age Totals line for this date & dose.
+49 ;I BIDOSE>1 S X=$$SUML(BIDATEX) D WRITE(.BILINE,X) ;S BILSAV=BILINE
+50 NEW X
SET X=" #"_BIDOSE_" |"
NEW BIA
+51 FOR BIA=1:1:6
SET X=X_$JUSTIFY($GET(BITMP("STATS",BIDATE,BIDOSE,"AGE",BIA)),7,0)_" "
+52 ;---> Last line special just to concat "|".
+53 SET X=X_$JUSTIFY($GET(BITMP("STATS",BIDATE,BIDOSE,"AGE",7)),7,0)_" |"
+54 ;
+55 ;---> Now concat Total column (for this dose).
+56 SET X=X_$JUSTIFY($GET(BITMP("STATS",BIDATE,BIDOSE,"TOTAL")),7,0)
+57 DO WRITE(.BILINE,X)
IF BIDOSE=1
SET BILSAV=BILINE
End DoDot:2
+58 ;
+59 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+60 ;
+61 ;---> Now mark the top line of this vaccine to print as one record.
+62 IF $GET(BILSAV)
DO MARK^BIW(BILSAV,BILINE-BILSAV,"BIREPH1")
End DoDot:1
+63 ;
+64 ;---> Now write totals.
+65 SET X=" Total H1N1 First Doses"
+66 SET X=X_$$SP^BIUTL5(48)_"|"_$JUSTIFY(+$GET(BITMP("STATS","DOSES",1,"TOTAL")),7,0)
+67 DO WRITE(.BILINE,X)
+68 ;
+69 SET X=" Total H1N1 Second Doses"
+70 SET X=X_$$SP^BIUTL5(47)_"|"_$JUSTIFY(+$GET(BITMP("STATS","DOSES",2,"TOTAL")),7,0)
+71 DO WRITE(.BILINE,X)
DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+72 ;
+73 SET X=" Total H1N1 Immunizations"
+74 SET X=X_$$SP^BIUTL5(46)_"|"_$JUSTIFY(+$GET(BITMP("STATS","ALL","TOTAL")),7,0)
+75 DO WRITE(.BILINE,X)
DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+76 ;
+77 ;---> Now write total patients considered who had refusals.
+78 ;---> Not desired on this report, per Ros 10-12-05
+79 ;N M,N S (M,N)=0 F S M=$O(BITMP("REFUSALS",M)) Q:'M S N=N+1
+80 ;S X=" Total Patients included who had Refusals on record"_$J(N,28)
+81 ;D WRITE(.BILINE,X),WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+82 ;
+83 ;---> Set final VALMCNT (Listman line count).
+84 SET VALMCNT=BILINE
+85 QUIT
+86 ;
+87 ;
+88 ;----------
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,"BIREPH1",$GET(BIVAL),$GET(BIBLNK))
+8 ;
+9 ;--->Set VALMCNT (Listman line count) for errors calls above.
+10 SET VALMCNT=BILINE
+11 QUIT
+12 ;
+13 ;
+14 ;----------
SUML(Y) ;EP
+1 ;---> Produce Header array for Vaccine Accountability Report.
+2 ;---> Parameters:
+3 ; 1 - Y (opt) Y=text, such as Date (Aug 23) or "Dose" or other text.
+4 IF $LENGTH($GET(Y))=0
SET Y=" "
+5 SET Y=$EXTRACT(Y,1,7)
SET Y=$$PAD^BIUTL5(Y,7)
+6 NEW X
+7 SET X=Y_" | |"
+8 ; " Date | 6-23m 24-59m 5-18y 19-25y 25-49y 50-64y "
+9 ;S X=Y_" | ------ ------ ------ ------ ------ ------ --"
+10 ; "65+y TOTAL"
+11 ;Q X_"---- | ------"
+12 QUIT X
