BIREPP2 ;IHS/CMI/MWR - REPORT, PCV; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW OR PRINT PCV REPORT.
;
;----------
HEAD(BIBEGDT,BIENDDT,BICC,BIUP) ;EP
;---> Produce Header array for PCV Report.
;---> Parameters:
; 1 - BIBEGDT (req) Begin date of report.
; 2 - BIENDDT (req) End date of report.
; 3 - BICC (req) Current Community array.
; 4 - BIUP (req) User Population/Group (r,i,u,a).
;
;---> Check for required Variables.
Q:'$G(BIBEGDT)
Q:'$G(BIENDDT)
Q:'$D(BICC)
S:$G(BIUP)="" BIUP="u"
;
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="* PCV 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=" "_$$BIUPTX^BIUTL6(BIUP)
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
.;
.S X=" # of Children | 0-59m 2-23m 24-59m 6-11m 12-23m"
.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,BIUP) ;EP
;---> Produce temp global for PCV Report.
;---> Parameters:
; 1 - BIBEGDT (req) Begin date of report.
; 2 - BIENDDT (req) End date of report.
; 3 - BICC (req) Current Community array.
; 4 - BIUP (req) User Population/Group (r,i,u,a).
;
K ^TMP("BIREPP1",$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
S:$G(BIUP)="" BIUP="u"
;
;---> Gather data.
D GETIMMS^BIREPP3(BIBEGDT,BIENDDT,.BICC,BIUP)
D TALLY^BIREPP3
Q
;
;
;----------
DISPLAY ;EP
;---> Create Listman display global for PCV Report.
;---> Parameters:
;---> Write Denominator line.
N BILINE S BILINE=0
N X S X=" Denominator | "
N N F N=1:1:5 S X=X_$J(+$G(^TMP("BIREPP1",$J,"TOTALPATS",N)),8,0)_" "
D WRITE(.BILINE,X)
D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
;
;---> Write Doses lines.
N BIAGRP,BIDOSE
F BIDOSE=1,3,4 D
.N X,Y S X=" "_BIDOSE_"+ doses PCV13 | "
.;---> Next line without percents%.
.;F BIAGRP=1:1:5 S X=X_$J(+$G(^TMP("BIREPP1",$J,"TALLY",BIDOSE,BIAGRP)),8,0)_" "
.F BIAGRP=1:1:5 S Y=+$G(^TMP("BIREPP1",$J,"TALLY",BIDOSE,BIAGRP)),X=X_$J(Y,8,0)_" "
.D WRITE(.BILINE,X)
.S X=" | "
.F BIAGRP=1:1:5 D
..N Y,Z S Y=+$G(^TMP("BIREPP1",$J,"TALLY",BIDOSE,BIAGRP))
..S Z=+$G(^TMP("BIREPP1",$J,"TOTALPATS",BIAGRP))
..S X=X_$J(100*$S(Z:Y/Z,1:0),8,0)_"% "
.D WRITE(.BILINE,X)
.D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
;
;---> Write PCV13 Totals line.
S X=" Total Doses | "
D WRITE(.BILINE,X) D MARK^BIW(BILINE,2,"BIREPP1")
S X=" in Date Range | "
F N=1:1:5 S X=X_$J(+$G(^TMP("BIREPP1",$J,"TOTALPCV13",N)),8,0)_" "
D WRITE(.BILINE,X)
D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
;
;---> Set final VALMCNT (Listman line count).
S VALMCNT=BILINE
Q
;
;
;----------
EXPORT ;EP
;---> Export PCV Report patients to Excel(csv) File, and return to PCV Report.
D EXPORT1
;---> BINOUP=1 means do not update report.
S BINOUP=1
D RESET^BIREPP1
Q
;
;
;----------
EXPORT1 ;EP
;---> Export PCV Report patients to Excel(csv) File.
;
I '$O(^TMP("BIREPP1",$J,"BIDFN",0)) D Q
.W !!?3,"There is no patient data to export." D DIRZ^BIUTL3()
;
N BIDT,BIDUZ2,BIFLNM,BINOW,BIPATH,BIPOP,BISITE
D NOW^%DTC S BIDT=$E(%,4,7)_"_"_$E(%,9,12)
S BIFLNM="PCV Export "_BIDT_".csv"
D HFS^BIEXPRT8(BIFLNM,.BIPATH,1,.BIPOP)
I $G(BIPOP) D ^%ZISC W !!?3,"Failure to open Host File." D DIRZ^BIUTL3() Q
;---> Host file is open.
;
;---> Use "," for CSV delimiter.
N Q,D S Q="""",D=Q_","_Q
;---> Write Title Header row.
;---> Date String, BINOW
D
.N %,X,Y D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S BINOW=Y
;---> Facility String, BIDUZ2
S BIDUZ2=$$INSTTX^BIUTL6($G(DUZ(2)))
N Y S Y=Q_"PCV Report Patient Export"_D_"at "_BIDUZ2_D_"on "_BINOW
I $G(BIUP)]"" S Y=Y_D_"User Population: "_$$BIUPTX^BIUTL6(BIUP)_Q
W Y,!
;
;---> Write Column Headers row.
S Y=Q_"Patient Name"_D_"Date of Birth"_D_"Chart#"_D_"Current Community"
S Y=Y_D_"CVX#1"_D_"Date"_D_"Invalid Code"
S Y=Y_D_"CVX#2"_D_"Date"_D_"Invalid Code"
S Y=Y_D_"CVX#3"_D_"Date"_D_"Invalid Code"
S Y=Y_D_"CVX#4"_D_"Date"_D_"Invalid Code"
S Y=Y_D_"CVX#5"_D_"Date"_D_"Invalid Code"
S Y=Y_D_"CVX#6"_D_"Date"_D_"Invalid Code"_Q
W Y,!
;
;---> Write data records.
N BIDFN S BIDFN=0
F S BIDFN=$O(^TMP("BIREPP1",$J,"BIDFN",BIDFN)) Q:'BIDFN D
.Q:'$D(^TMP("BIREPP1",$J,"BIDFN",BIDFN,"EXPORT"))
.N BIDATA,BIPNAME,BICC
.S BIDATA=^TMP("BIREPP1",$J,"BIDFN",BIDFN,"EXPORT")
.S BIPNAME=$$NAME^BIUTL1(BIDFN)
.S BIDOB=$$DOBF^BIUTL1(BIDFN,,1,1)
.S BIHRCN=$$HRCN^BIUTL1(BIDFN,$G(DUZ(2)),1)
.S BICC=$$CURCOM^BIUTL11(BIDFN,1)
.S Q="""",D=Q_","_Q
.W Q_BIPNAME_D_BIDOB_D_BIHRCN_D_BICC_D_BIDATA_Q,!
;
;---> Close the host file and report its location.
D ^%ZISC
D TITLE^BIUTL5("EXPORT PCV PATIENT DATA TO EXCEL FILE")
W !!?5,"The PCV Report patient data has been exported to:"
W !!?10,BIPATH_BIFLNM
D TEXT3^BIEXP
D DIRZ^BIUTL3()
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,"BIREPP1",$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
BIREPP2 ;IHS/CMI/MWR - REPORT, PCV; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW OR PRINT PCV REPORT.
+4 ;
+5 ;----------
HEAD(BIBEGDT,BIENDDT,BICC,BIUP) ;EP
+1 ;---> Produce Header array for PCV 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 - BIUP (req) User Population/Group (r,i,u,a).
+7 ;
+8 ;---> Check for required Variables.
+9 IF '$GET(BIBEGDT)
QUIT
+10 IF '$GET(BIENDDT)
QUIT
+11 IF '$DATA(BICC)
QUIT
+12 IF $GET(BIUP)=""
SET BIUP="u"
+13 ;
+14 KILL VALMHDR
+15 NEW BILINE,X
SET BILINE=0
+16 ;
+17 NEW X
SET X=""
+18 ;---> If Header array is NOT being for Listmananger include version.
+19 IF '$DATA(VALM("BM"))
SET X=$$LMVER^BILOGO()
+20 ;
+21 DO WH^BIW(.BILINE,X)
+22 SET X=$$REPHDR^BIUTL6(DUZ(2))
DO CENTERT^BIUTL5(.X)
+23 DO WH^BIW(.BILINE,X)
+24 ;
+25 SET X="* PCV Report *"
DO CENTERT^BIUTL5(.X)
+26 DO WH^BIW(.BILINE,X)
+27 ;
+28 SET X=$$SP^BIUTL5(27)_"Report Date: "_$$SLDT1^BIUTL5(DT)
+29 DO WH^BIW(.BILINE,X)
+30 ;
+31 SET X=$$SP^BIUTL5(28)_"Date Range: "_$$SLDT1^BIUTL5(BIBEGDT)_" - "_$$SLDT1^BIUTL5(BIENDDT)
+32 DO WH^BIW(.BILINE,X,1)
+33 ;
+34 SET X=" "_$$BIUPTX^BIUTL6(BIUP)
+35 DO WH^BIW(.BILINE,X)
+36 SET X=$$SP^BIUTL5(79,"-")
+37 DO WH^BIW(.BILINE,X)
+38 ;
+39 Begin DoDot:1
+40 ;---> If specific Communities were selected (not ALL), then print
+41 ;---> the Communities in a subheader at the top of the report.
+42 DO SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR,,12)
+43 IF $GET(BIERR)
DO ERRCD^BIUTL2(BIERR,.X)
DO WH^BIW(.BILINE,X)
QUIT
+44 ;
+45 SET X=" # of Children | 0-59m 2-23m 24-59m 6-11m 12-23m"
+46 DO WH^BIW(.BILINE,X)
End DoDot:1
+47 ;
+48 ;---> If Header array is being built for Listmananger,
+49 ;---> reset display window margins for Communities, etc.
+50 IF $DATA(VALM("BM"))
Begin DoDot:1
+51 SET VALM("TM")=BILINE+3
+52 SET VALM("LINES")=VALM("BM")-VALM("TM")+1
+53 ;---> Safeguard to prevent divide/0 error.
+54 IF VALM("LINES")<1
SET VALM("LINES")=1
End DoDot:1
+55 QUIT
+56 ;
+57 ;
+58 ;----------
GET(BIBEGDT,BIENDDT,BICC,BIUP) ;EP
+1 ;---> Produce temp global for PCV 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 - BIUP (req) User Population/Group (r,i,u,a).
+7 ;
+8 KILL ^TMP("BIREPP1",$JOB),^TMP("BIDFN",$JOB)
+9 NEW BILINE,BITMP,X
SET BILINE=0
+10 ;
+11 ;---> Check for required Variables.
+12 IF '$GET(BIBEGDT)
DO ERRCD^BIUTL2(626,.X)
DO WRITE(.BILINE,X)
QUIT
+13 IF '$GET(BIENDDT)
DO ERRCD^BIUTL2(627,.X)
DO WRITE(.BILINE,X)
QUIT
+14 IF '$DATA(BICC)
DO ERRCD^BIUTL2(614,.X)
DO WRITE(.BILINE,X)
QUIT
+15 IF $GET(BIUP)=""
SET BIUP="u"
+16 ;
+17 ;---> Gather data.
+18 DO GETIMMS^BIREPP3(BIBEGDT,BIENDDT,.BICC,BIUP)
+19 DO TALLY^BIREPP3
+20 QUIT
+21 ;
+22 ;
+23 ;----------
DISPLAY ;EP
+1 ;---> Create Listman display global for PCV Report.
+2 ;---> Parameters:
+3 ;---> Write Denominator line.
+4 NEW BILINE
SET BILINE=0
+5 NEW X
SET X=" Denominator | "
+6 NEW N
FOR N=1:1:5
SET X=X_$JUSTIFY(+$GET(^TMP("BIREPP1",$JOB,"TOTALPATS",N)),8,0)_" "
+7 DO WRITE(.BILINE,X)
+8 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+9 ;
+10 ;---> Write Doses lines.
+11 NEW BIAGRP,BIDOSE
+12 FOR BIDOSE=1,3,4
Begin DoDot:1
+13 NEW X,Y
SET X=" "_BIDOSE_"+ doses PCV13 | "
+14 ;---> Next line without percents%.
+15 ;F BIAGRP=1:1:5 S X=X_$J(+$G(^TMP("BIREPP1",$J,"TALLY",BIDOSE,BIAGRP)),8,0)_" "
+16 FOR BIAGRP=1:1:5
SET Y=+$GET(^TMP("BIREPP1",$JOB,"TALLY",BIDOSE,BIAGRP))
SET X=X_$JUSTIFY(Y,8,0)_" "
+17 DO WRITE(.BILINE,X)
+18 SET X=" | "
+19 FOR BIAGRP=1:1:5
Begin DoDot:2
+20 NEW Y,Z
SET Y=+$GET(^TMP("BIREPP1",$JOB,"TALLY",BIDOSE,BIAGRP))
+21 SET Z=+$GET(^TMP("BIREPP1",$JOB,"TOTALPATS",BIAGRP))
+22 SET X=X_$JUSTIFY(100*$SELECT(Z:Y/Z,1:0),8,0)_"% "
End DoDot:2
+23 DO WRITE(.BILINE,X)
+24 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
End DoDot:1
+25 ;
+26 ;---> Write PCV13 Totals line.
+27 SET X=" Total Doses | "
+28 DO WRITE(.BILINE,X)
DO MARK^BIW(BILINE,2,"BIREPP1")
+29 SET X=" in Date Range | "
+30 FOR N=1:1:5
SET X=X_$JUSTIFY(+$GET(^TMP("BIREPP1",$JOB,"TOTALPCV13",N)),8,0)_" "
+31 DO WRITE(.BILINE,X)
+32 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+33 ;
+34 ;---> Set final VALMCNT (Listman line count).
+35 SET VALMCNT=BILINE
+36 QUIT
+37 ;
+38 ;
+39 ;----------
EXPORT ;EP
+1 ;---> Export PCV Report patients to Excel(csv) File, and return to PCV Report.
+2 DO EXPORT1
+3 ;---> BINOUP=1 means do not update report.
+4 SET BINOUP=1
+5 DO RESET^BIREPP1
+6 QUIT
+7 ;
+8 ;
+9 ;----------
EXPORT1 ;EP
+1 ;---> Export PCV Report patients to Excel(csv) File.
+2 ;
+3 IF '$ORDER(^TMP("BIREPP1",$JOB,"BIDFN",0))
Begin DoDot:1
+4 WRITE !!?3,"There is no patient data to export."
DO DIRZ^BIUTL3()
End DoDot:1
QUIT
+5 ;
+6 NEW BIDT,BIDUZ2,BIFLNM,BINOW,BIPATH,BIPOP,BISITE
+7 DO NOW^%DTC
SET BIDT=$EXTRACT(%,4,7)_"_"_$EXTRACT(%,9,12)
+8 SET BIFLNM="PCV Export "_BIDT_".csv"
+9 DO HFS^BIEXPRT8(BIFLNM,.BIPATH,1,.BIPOP)
+10 IF $GET(BIPOP)
DO ^%ZISC
WRITE !!?3,"Failure to open Host File."
DO DIRZ^BIUTL3()
QUIT
+11 ;---> Host file is open.
+12 ;
+13 ;---> Use "," for CSV delimiter.
+14 NEW Q,D
SET Q=""""
SET D=Q_","_Q
+15 ;---> Write Title Header row.
+16 ;---> Date String, BINOW
+17 Begin DoDot:1
+18 NEW %,X,Y
DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET BINOW=Y
End DoDot:1
+19 ;---> Facility String, BIDUZ2
+20 SET BIDUZ2=$$INSTTX^BIUTL6($GET(DUZ(2)))
+21 NEW Y
SET Y=Q_"PCV Report Patient Export"_D_"at "_BIDUZ2_D_"on "_BINOW
+22 IF $GET(BIUP)]""
SET Y=Y_D_"User Population: "_$$BIUPTX^BIUTL6(BIUP)_Q
+23 WRITE Y,!
+24 ;
+25 ;---> Write Column Headers row.
+26 SET Y=Q_"Patient Name"_D_"Date of Birth"_D_"Chart#"_D_"Current Community"
+27 SET Y=Y_D_"CVX#1"_D_"Date"_D_"Invalid Code"
+28 SET Y=Y_D_"CVX#2"_D_"Date"_D_"Invalid Code"
+29 SET Y=Y_D_"CVX#3"_D_"Date"_D_"Invalid Code"
+30 SET Y=Y_D_"CVX#4"_D_"Date"_D_"Invalid Code"
+31 SET Y=Y_D_"CVX#5"_D_"Date"_D_"Invalid Code"
+32 SET Y=Y_D_"CVX#6"_D_"Date"_D_"Invalid Code"_Q
+33 WRITE Y,!
+34 ;
+35 ;---> Write data records.
+36 NEW BIDFN
SET BIDFN=0
+37 FOR
SET BIDFN=$ORDER(^TMP("BIREPP1",$JOB,"BIDFN",BIDFN))
IF 'BIDFN
QUIT
Begin DoDot:1
+38 IF '$DATA(^TMP("BIREPP1",$JOB,"BIDFN",BIDFN,"EXPORT"))
QUIT
+39 NEW BIDATA,BIPNAME,BICC
+40 SET BIDATA=^TMP("BIREPP1",$JOB,"BIDFN",BIDFN,"EXPORT")
+41 SET BIPNAME=$$NAME^BIUTL1(BIDFN)
+42 SET BIDOB=$$DOBF^BIUTL1(BIDFN,,1,1)
+43 SET BIHRCN=$$HRCN^BIUTL1(BIDFN,$GET(DUZ(2)),1)
+44 SET BICC=$$CURCOM^BIUTL11(BIDFN,1)
+45 SET Q=""""
SET D=Q_","_Q
+46 WRITE Q_BIPNAME_D_BIDOB_D_BIHRCN_D_BICC_D_BIDATA_Q,!
End DoDot:1
+47 ;
+48 ;---> Close the host file and report its location.
+49 DO ^%ZISC
+50 DO TITLE^BIUTL5("EXPORT PCV PATIENT DATA TO EXCEL FILE")
+51 WRITE !!?5,"The PCV Report patient data has been exported to:"
+52 WRITE !!?10,BIPATH_BIFLNM
+53 DO TEXT3^BIEXP
+54 DO DIRZ^BIUTL3()
+55 QUIT
+56 ;
+57 ;
+58 ;----------
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,"BIREPP1",$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
