BIREPD1 ;IHS/CMI/MWR - REPORT, ADOLESCENT RATES; MAY 10, 2010
;;8.5;IMMUNIZATION;**5**;JUL 01,2013
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW OR PRINT ADOLESCENT IMMUNIZATION RATES REPORT.
;; PATCH 5: Return Patient Totals for queued reports. PRINT+12, INIT+6, DEQUEUE+5
;
;
;----------
START(BIX) ;EP
;---> Prepare and display or print Adolescent Rates Report.
;---> Parameters:
; 1 - BIX (req) If BIX="PRINT", then print Report.
; If BIX="VIEW", then view Report (default).
;---> Variables:
; 1 - BIQDT (req) Quarter Ending Date.
; 2 - BIDAR (opt) Adolescent Report Age Range: 11-17.
; 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 - BIUP (req) User Population/Group
; (Registered, Imm Reg Active, User 1+, Active 2+).
; 8 - BIPOP (ret) BIPOP=1 if error.
;
;---> Check for required Variables.
I '$G(BIQDT) D ERRCD^BIUTL2(622,,1) D RESET^BIREPD Q
I '$D(BICC) D ERRCD^BIUTL2(614,,1) D RESET^BIREPD Q
I '$D(BIHCF) D ERRCD^BIUTL2(625,,1) D RESET^BIREPD Q
I '$D(BICM) D ERRCD^BIUTL2(615,,1) D RESET^BIREPD Q
I '$D(BIBEN) D ERRCD^BIUTL2(662,,1) D RESET^BIREPD Q
I '$G(BISITE) S BISITE=$G(DUZ(2))
I '$G(BISITE) D ERRCD^BIUTL2(109,,1) D RESET^BIREPD Q
;
S:$G(BIUP)="" BIUP="u"
S:'$G(BIDAR) BIDAR="11-17^1"
S BIAGRPS="1112,1313,1317"
;
;---> BITOTPTS=Total Patients, used by HDR code after EN.
N BITOTPTS,BITOTFPT,BITOTMPT
;
D SETVARS^BIUTL5 N VALMCNT
I $G(BIX)="PRINT" D PRINT,RESET^BIREPD Q
;
;
;---> Set BIAG for Age Range in header of report.
;---> Set BIRPDT for Report Date ("Quarterly, etc.).
;---> Set BIRTN in case user runs Patient List then needs to return
;---> to INIT here.
;---> Set BITITL for Report Name in Patient List, if called.
N BIRPDT,BIRTN,BITITL
S BIRPDT=BIQDT,BIRTN="BIREPD1",BITITL="ADOLESCENT"
D EN
Q
;
;
;----------
PRINT ;EP
;---> Main entry point for printing the Adolescent Rates Report.
D DEVICE(.BIPOP)
Q:$G(BIPOP)
;
D:$G(IO)'=$G(IO(0))
.W !!?10,"This may take some time. Please hold on...",!
;
;---> Prepare report.
K ^TMP("BIREPD1",$J),^TMP("BIDUL",$J)
N VALM,VALMHDR
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Return Patient Totals for queued reports.
;D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP),HDR
D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP,.BITOTPTS,.BITOTFPT,.BITOTMPT)
D HDR
;**********
;
D PRTLST^BIUTL8("BIREPD1")
D EXIT,RESET^BIREPD
Q
;
;
;----------
EN ;EP
;---> Main entry point for List Template BI REPORT ADOLESCENT RATES1.
D EN^VALM("BI REPORT ADOLESCENT RATES1")
Q
;
;
;----------
HDR ;EP
;---> Header code
D HEAD^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BIUP)
Q
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
S VALM("TITLE")=$$LMVER^BILOGO
W !!?10,"This may take some time. Please hold on...",!
K ^TMP("BIREPD1",$J),^TMP("BIDUL",$J)
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Return Patient Totals for queued reports.
;D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP)
D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP,.BITOTPTS,.BITOTFPT,.BITOTMPT)
;**********
;
;---> Set up ZTSAVE in case user Queues from PL in List.
D ZSAVES^BIUTL3
Q
;
;
;----------
RESET ;EP
;---> Update partition for return to Listmanager.
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
D INIT,HDR Q
;
;
;----------
HELP ;EP
N BIX S BIX=X
D FULL^VALM1 N BIPOP
D TITLE^BIUTL5("VIEW ADOLESCENT REPORT - HELP")
D TEXT1,DIRZ^BIUTL3()
D:BIX'="??" RE^VALM4
Q
;
;
;----------
TEXT1 ;EP
;;You have chosen to View the Adolescent Report rather than Print it.
;;(You may print the report from here as well by entering "PL".)
;;
;;Also, you may:
;;
;;Enter "N" to view the list of Patients who were NOT Current
;; or "NOT up-to-date" with their immunizations, according
;; to recommendeded guidelines for their age.
;;
;;Enter "C" to view the list of Patients who were CURRENT or
;; "up-to-date" with their immunizations, according to
;; recommendeded guidelines for their age.
;;
;;Enter "B" to view a list of both groups of patients combined.
;;
;;
D PRINTX("TEXT1")
Q
;
;
;----------
EXIT ;EP
;---> Cleanup, EOJ.
K ^TMP("BIREPD1",$J)
D CLEAR^VALM1
D FULL^VALM1
Q
;
;
;----------
DEVICE(BIPOP) ;EP
;---> Get Device and possibly queue to Taskman.
;---> Parameters:
; 1 - BIPOP (ret) If error or Queue, BIPOP=1
;
K %ZIS,IOP S BIPOP=0
S ZTRTN="DEQUEUE^BIREPD1"
D ZSAVES^BIUTL3
D ZIS^BIUTL2(.BIPOP,1)
Q
;
;
;----------
DEQUEUE ;EP
;
;---> Prepare and print Two-Year-Old Report.
K VALMHDR,^TMP("BIREPD1",$J)
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Return Patient Totals for queued reports and headings.
;D HDR^BIREPD1
;D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP)
D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP,.BITOTPTS,.BITOTFPT,.BITOTMPT)
D HDR^BIREPD1
;**********
;
D PRTLST^BIUTL8("BIREPD1"),EXIT
Q
;
;
;----------
PRINTX(BILINL,BITAB) ;EP
Q:$G(BILINL)=""
N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
Q
BIREPD1 ;IHS/CMI/MWR - REPORT, ADOLESCENT RATES; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**5**;JUL 01,2013
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW OR PRINT ADOLESCENT IMMUNIZATION RATES REPORT.
+4 ;; PATCH 5: Return Patient Totals for queued reports. PRINT+12, INIT+6, DEQUEUE+5
+5 ;
+6 ;
+7 ;----------
START(BIX) ;EP
+1 ;---> Prepare and display or print Adolescent Rates Report.
+2 ;---> Parameters:
+3 ; 1 - BIX (req) If BIX="PRINT", then print Report.
+4 ; If BIX="VIEW", then view Report (default).
+5 ;---> Variables:
+6 ; 1 - BIQDT (req) Quarter Ending Date.
+7 ; 2 - BIDAR (opt) Adolescent Report Age Range: 11-17.
+8 ; 3 - BICC (req) Current Community array.
+9 ; 4 - BIHCF (req) Health Care Facility array.
+10 ; 5 - BICM (req) Case Manager array.
+11 ; 6 - BIBEN (req) Beneficiary Type array.
+12 ; 7 - BIUP (req) User Population/Group
+13 ; (Registered, Imm Reg Active, User 1+, Active 2+).
+14 ; 8 - BIPOP (ret) BIPOP=1 if error.
+15 ;
+16 ;---> Check for required Variables.
+17 IF '$GET(BIQDT)
DO ERRCD^BIUTL2(622,,1)
DO RESET^BIREPD
QUIT
+18 IF '$DATA(BICC)
DO ERRCD^BIUTL2(614,,1)
DO RESET^BIREPD
QUIT
+19 IF '$DATA(BIHCF)
DO ERRCD^BIUTL2(625,,1)
DO RESET^BIREPD
QUIT
+20 IF '$DATA(BICM)
DO ERRCD^BIUTL2(615,,1)
DO RESET^BIREPD
QUIT
+21 IF '$DATA(BIBEN)
DO ERRCD^BIUTL2(662,,1)
DO RESET^BIREPD
QUIT
+22 IF '$GET(BISITE)
SET BISITE=$GET(DUZ(2))
+23 IF '$GET(BISITE)
DO ERRCD^BIUTL2(109,,1)
DO RESET^BIREPD
QUIT
+24 ;
+25 IF $GET(BIUP)=""
SET BIUP="u"
+26 IF '$GET(BIDAR)
SET BIDAR="11-17^1"
+27 SET BIAGRPS="1112,1313,1317"
+28 ;
+29 ;---> BITOTPTS=Total Patients, used by HDR code after EN.
+30 NEW BITOTPTS,BITOTFPT,BITOTMPT
+31 ;
+32 DO SETVARS^BIUTL5
NEW VALMCNT
+33 IF $GET(BIX)="PRINT"
DO PRINT
DO RESET^BIREPD
QUIT
+34 ;
+35 ;
+36 ;---> Set BIAG for Age Range in header of report.
+37 ;---> Set BIRPDT for Report Date ("Quarterly, etc.).
+38 ;---> Set BIRTN in case user runs Patient List then needs to return
+39 ;---> to INIT here.
+40 ;---> Set BITITL for Report Name in Patient List, if called.
+41 NEW BIRPDT,BIRTN,BITITL
+42 SET BIRPDT=BIQDT
SET BIRTN="BIREPD1"
SET BITITL="ADOLESCENT"
+43 DO EN
+44 QUIT
+45 ;
+46 ;
+47 ;----------
PRINT ;EP
+1 ;---> Main entry point for printing the Adolescent Rates Report.
+2 DO DEVICE(.BIPOP)
+3 IF $GET(BIPOP)
QUIT
+4 ;
+5 IF $GET(IO)'=$GET(IO(0))
Begin DoDot:1
+6 WRITE !!?10,"This may take some time. Please hold on...",!
End DoDot:1
+7 ;
+8 ;---> Prepare report.
+9 KILL ^TMP("BIREPD1",$JOB),^TMP("BIDUL",$JOB)
+10 NEW VALM,VALMHDR
+11 ;
+12 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+13 ;---> Return Patient Totals for queued reports.
+14 ;D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP),HDR
+15 DO START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP,.BITOTPTS,.BITOTFPT,.BITOTMPT)
+16 DO HDR
+17 ;**********
+18 ;
+19 DO PRTLST^BIUTL8("BIREPD1")
+20 DO EXIT
DO RESET^BIREPD
+21 QUIT
+22 ;
+23 ;
+24 ;----------
EN ;EP
+1 ;---> Main entry point for List Template BI REPORT ADOLESCENT RATES1.
+2 DO EN^VALM("BI REPORT ADOLESCENT RATES1")
+3 QUIT
+4 ;
+5 ;
+6 ;----------
HDR ;EP
+1 ;---> Header code
+2 DO HEAD^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BIUP)
+3 QUIT
+4 ;
+5 ;
+6 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 SET VALM("TITLE")=$$LMVER^BILOGO
+3 WRITE !!?10,"This may take some time. Please hold on...",!
+4 KILL ^TMP("BIREPD1",$JOB),^TMP("BIDUL",$JOB)
+5 ;
+6 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+7 ;---> Return Patient Totals for queued reports.
+8 ;D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP)
+9 DO START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP,.BITOTPTS,.BITOTFPT,.BITOTMPT)
+10 ;**********
+11 ;
+12 ;---> Set up ZTSAVE in case user Queues from PL in List.
+13 DO ZSAVES^BIUTL3
+14 QUIT
+15 ;
+16 ;
+17 ;----------
RESET ;EP
+1 ;---> Update partition for return to Listmanager.
+2 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+3 DO TERM^VALM0
SET VALMBCK="R"
+4 DO INIT
DO HDR
QUIT
+5 ;
+6 ;
+7 ;----------
HELP ;EP
+1 NEW BIX
SET BIX=X
+2 DO FULL^VALM1
NEW BIPOP
+3 DO TITLE^BIUTL5("VIEW ADOLESCENT REPORT - HELP")
+4 DO TEXT1
DO DIRZ^BIUTL3()
+5 IF BIX'="??"
DO RE^VALM4
+6 QUIT
+7 ;
+8 ;
+9 ;----------
TEXT1 ;EP
+1 ;;You have chosen to View the Adolescent Report rather than Print it.
+2 ;;(You may print the report from here as well by entering "PL".)
+3 ;;
+4 ;;Also, you may:
+5 ;;
+6 ;;Enter "N" to view the list of Patients who were NOT Current
+7 ;; or "NOT up-to-date" with their immunizations, according
+8 ;; to recommendeded guidelines for their age.
+9 ;;
+10 ;;Enter "C" to view the list of Patients who were CURRENT or
+11 ;; "up-to-date" with their immunizations, according to
+12 ;; recommendeded guidelines for their age.
+13 ;;
+14 ;;Enter "B" to view a list of both groups of patients combined.
+15 ;;
+16 ;;
+17 DO PRINTX("TEXT1")
+18 QUIT
+19 ;
+20 ;
+21 ;----------
EXIT ;EP
+1 ;---> Cleanup, EOJ.
+2 KILL ^TMP("BIREPD1",$JOB)
+3 DO CLEAR^VALM1
+4 DO FULL^VALM1
+5 QUIT
+6 ;
+7 ;
+8 ;----------
DEVICE(BIPOP) ;EP
+1 ;---> Get Device and possibly queue to Taskman.
+2 ;---> Parameters:
+3 ; 1 - BIPOP (ret) If error or Queue, BIPOP=1
+4 ;
+5 KILL %ZIS,IOP
SET BIPOP=0
+6 SET ZTRTN="DEQUEUE^BIREPD1"
+7 DO ZSAVES^BIUTL3
+8 DO ZIS^BIUTL2(.BIPOP,1)
+9 QUIT
+10 ;
+11 ;
+12 ;----------
DEQUEUE ;EP
+1 ;
+2 ;---> Prepare and print Two-Year-Old Report.
+3 KILL VALMHDR,^TMP("BIREPD1",$JOB)
+4 ;
+5 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+6 ;---> Return Patient Totals for queued reports and headings.
+7 ;D HDR^BIREPD1
+8 ;D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP)
+9 DO START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP,.BITOTPTS,.BITOTFPT,.BITOTMPT)
+10 DO HDR^BIREPD1
+11 ;**********
+12 ;
+13 DO PRTLST^BIUTL8("BIREPD1")
DO EXIT
+14 QUIT
+15 ;
+16 ;
+17 ;----------
PRINTX(BILINL,BITAB) ;EP
+1 IF $GET(BILINL)=""
QUIT
+2 NEW I,T,X
SET T=""
IF '$DATA(BITAB)
SET BITAB=5
FOR I=1:1:BITAB
SET T=T_" "
+3 FOR I=1:1
SET X=$TEXT(@BILINL+I)
IF X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+4 QUIT
