BIUTL3 ;IHS/CMI/MWR - UTIL: ZTSAVE, ASKDATE, DIRZ.; MAY 10, 2010
;;8.5;IMMUNIZATION;**5**;JUL 01,2013
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; UTILITY: SAVE ANY AND ALL BI VARIABLES FOR QUEUEING TO TASKMAN,
;; ASK DATE RANGE, DIRZ (PROMPT TO CONTINUE).
;; PATCH 2: Add more variables to save: BIDELIM, BIU19.
;; PATCH 5: Add more variables to save: BITOTPTS, BITOTFPT, BITOTMPT ZSAVES+77
;
;
;----------
ZSAVES ;EP
;---> Single central calling point for saving BI local
;---> variables and arrays in ZTSAVE for queuing to Taskman.
;---> Any of the BI variables listed below, if defined,
;---> will be stored in the ZTSAVE array.
;---> To add additional variables or arrays, simply document
;---> in the list and add to appropriate FOR loop below.
;
;---> Variables:
;
; ZTSAVE (ret) Taskman array of saved variables and arrays.
;
; Single:
; -------
; BIACT (opt) All or ACTIVE Only in Patient Errors.
; BIAG (opt) Age Range in months.
; BIAGRP (opt) Node/number for this Age Group.
; BIAGRPS (opt) Age Groups in Two-Year-Old Report.
; BIBEGDT (opt) Begin date of report.
; BICOLL (opt) Order of Lot Number listing, 1-4.
; BICPTI (opt) 1=Include CPT Coded Visits, 0=Ignore CPT (default).
; BIDAR (opt) Adolescent Report Age Range: "11-18^1" (years).
; BIDED (opt) Include Deceased Patients (0=no, 1=yes).
; BIDELIM (opt) Delimiter (1="^", 2="2 spaces").
; BIDFN (opt) Patient's IEN in VA PATIENT File #2.
; BIDLOC (opt) Date-Location Line of letter.
; BIDLOT (opt) Display report by Lot Number (VAC).
; BIENDDT (opt) End date of report.
; BIFDT (opt) Forecast/Clinic date.
; BIFH (opt) F=report on Flu Vaccine Group, H=H1N1 group.
; BIHIST (opt) Include Historical (Vac Acct Report).
; BIHPV (opt) 1=include HepA, Pneumo & Var, 0=exclude.
; BILET (opt) IEN of Letter in BI LETTER File.
; BIMD (opt) Minimum Interval days since last letter.
; BINFO (opt) Additional Information for each patient (no longer used).
; BIORD (opt) Order of listing.
; BIPG (opt) Patient Group (see calling routine).
; BIQDT (opt) Quarter Ending Date.
; BIRDT (opt) Date Range for Received Imms (form BEGDATE:ENDDATE).
; BIRPDT (opt) Report Date in View List (if passed from reports).
; BISITE (opt) IEN of Site.
; BISUBT (opt) Subtitle String for Lot Order in BILOT.
; BITAR (opt) Two-Yr-Old Report Age Range.
; BITOTPTS(opt) Total Number of Patients.
; BITOTFPT(opt) Total Number of Female Patients.
; BITOTMPT(opt) Total Number of Male Patients.
; BIU19 (opt) Include Adults (19 yrs & over).
; BIUP (opt) User Population/Group (Registered, User, Active).
; BIVFC (opt) VFC Eligibility for Imm Visits.
; BIYEAR (opt) Report Year.
;
; Arrays:
; -------
; BIBEN (opt) Beneficiary Type array.
; BICC (opt) Current Community array.
; BICM (opt) Case Manager array.
; BIDPRV (opt) Designated Provider array.
; BIHCF (opt) Health Care Facility array.
; BILOT (opt) Lot Number array.
; BIMMD (opt) Immunization Due array.
; BIMMR (opt) Immunization Received array.
; BIMMRF (opt) Immunization Received Filter array.
; BIMMLF (opt) Lot Number Filter array.
; BINFO (opt) Additional Information for each patient.
; BIVT (opt) Visit Type array.
;
;---> Save local variables for queueing Due List/Letters.
K ZTSAVE N BISV
;
F BISV="ACT","AG","AGRP","AGRPS","BEGDT","COLL","CPTI","DAR","DED","DELIM","DFN" D
.S BISV="BI"_BISV
.I $D(@(BISV)) S ZTSAVE(BISV)=""
;
F BISV="DLOC","DLOT","ENDDT","FDT","FH","HIST","HPV","LET","MD","NFO","ORD" D
.S BISV="BI"_BISV
.I $D(@(BISV)) S ZTSAVE(BISV)=""
;
F BISV="PG","QDT","RDT","RPDT","SITE","SUBT","T","TAR","TOTPTS","TOTFPT","TOTFMPT" D
.S BISV="BI"_BISV
.I $D(@(BISV)) S ZTSAVE(BISV)=""
;
F BISV="U19","UP","VFC","YEAR" D
.S BISV="BI"_BISV
.I $D(@(BISV)) S ZTSAVE(BISV)=""
;
;---> Save local arrays for queueing Due List/Letters.
F BISV="BEN","CC","CM","DPRV","HCF","LOT","MMD","MMLF","MMR","MMRF","VT" D
.S BISV="BI"_BISV
.D:$D(@BISV)
..N N S N=0 F S N=$O(@(BISV_"("""_N_""")")) Q:N="" D
...S ZTSAVE(BISV_"("""_N_""")")=""
Q
;
;
;----------
ASKDATES(BIB,BIE,BIPOP,BIBDF,BIEDF,BISAME,BITIME) ;EP
;---> Ask date range.
;---> Parameters:
; 1 - BIB (ret) Begin Date, Fileman format.
; 2 - BIE (ret) End Date, Fileman format.
; 3 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
; 4 - BIBDF (opt) Begin Date default, Fileman format.
; 5 - BIEDF (opt) End Date default, Fileman format.
; 6 - BISAME (opt) Force End Date default=Begin Date.
; 7 - BITIME (opt) Ask times.
;
;---> Example:
; D ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,"T-365","T")
;
S BIPOP=0 N %DT,Y
W !!," *** Date Range Selection ***"
;
;---> Begin Date.
S %DT="APEX"_$S($G(BITIME):"T",1:"")
S %DT("A")=" Begin with DATE: "
I $G(BIBDF)]"" S Y=BIBDF D DD^%DT S %DT("B")=Y
D ^%DT K %DT
I Y<0 S BIPOP=1 Q
;
;---> End Date.
S (%DT(0),BIB)=Y K %DT("B")
S %DT="APEX"_$S($D(BITIME):"T",1:"")
S %DT("A")=" End with DATE: "
I $G(BIEDF)]"" S Y=BIEDF D DD^%DT S %DT("B")=Y
I $D(BISAME) S Y=BIB D DD^%DT S %DT("B")=Y
D ^%DT K %DT
I Y<0 S BIPOP=1 Q
S BIE=Y
Q
;
;
;----------
DATE(BIDT,BIPOP,BIDFLT,BIPRMPT,BITIME) ;EP
;---> Ask Date.
;---> Parameters:
; 1 - BIDT (ret) Selected Date, Fileman format.
; 2 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
; 3 - BIDFLT (opt) Default, Fileman format.
; 4 - BIPRMPT (opt) Prompt.
; 5 - BITIME (opt) Ask times.
;
;---> EXAMPLE:
; D DATE^BIUTL3(.BIDT,.BIPOP,DT)
;
S BIPOP=0 N %DT,Y
S %DT="APEX"_$S($G(BITIME):"T",1:"")
S:$G(BIPRMPT)="" BIPRMPT=" Enter DATE: "
S %DT("A")=BIPRMPT
I $G(BIDFLT)]"" S Y=BIDFLT D DD^%DT S %DT("B")=Y
D ^%DT K %DT
I Y<0 S BIPOP=1 Q
S BIDT=Y
Q
;
;
;----------
LOCKED ;EP
D EN^DDIOL("Another user is editing this entry. Please, try again later.",,"!?5")
D DIRZ()
Q
;
;
;----------
DIRZ(BIPOP,BIPRMT,BIPRMT1,BIPRMT2,BIPRMTQ) ;EP - Press RETURN to continue.
;---> Call to ^DIR, to Press RETURN to continue.
;---> Parameters:
; 1 - BIPOP (ret) BIPOP=1 if DTOUT or DUOUT
; 2 - BIPRMT (opt) Prompt other than "Press RETURN..."
; 3 - BIPRMT1 (opt) Prompt other than "Press RETURN..."
; 4 - BIPRMT2 (opt) Prompt other than "Press RETURN..."
; 5 - BIPRMTQ (opt) Response to "?" other than standard
;
;---> Example: D DIRZ^BIUTL3(.BIPOP)
;
N DDS,DIR,DIRUT,X,Y,Z
D
.I $G(BIPRMT)="" D Q
..S DIR("A")=" Press ENTER/RETURN to continue or ""^"" to exit"
.S DIR("A")=BIPRMT
.I $G(BIPRMT1)]"" S DIR("A",1)=BIPRMT1
.I $G(BIPRMT2)]"" S DIR("A",2)=BIPRMT2
I $G(BIPRMTQ)]"" S DIR("?")=BIPRMTQ
S DIR(0)="E" W ! D ^DIR W !
S BIPOP=$S($D(DIRUT):1,Y<1:1,1:0)
Q
;
;
;----------
NOW1 ;EP
;---> S BITTTS=Start time.
N %,Y,X D NOW^%DTC S BITTTS=%
Q
;
;
;----------
NOW2 ;EP
;---> S BITTTE=End time.
N %,Y,X D NOW^%DTC S BITTTE=%
;
;---> Compare times.
S Y=BITTTE X ^DD("DD") W !!?5,"End : ",$P(Y,"@",2)
S Y=BITTTS X ^DD("DD") W !?5,"Begin: ",$P(Y,"@",2)
D DIRZ()
K BITTTE,BITTTS
Q
BIUTL3 ;IHS/CMI/MWR - UTIL: ZTSAVE, ASKDATE, DIRZ.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**5**;JUL 01,2013
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; UTILITY: SAVE ANY AND ALL BI VARIABLES FOR QUEUEING TO TASKMAN,
+4 ;; ASK DATE RANGE, DIRZ (PROMPT TO CONTINUE).
+5 ;; PATCH 2: Add more variables to save: BIDELIM, BIU19.
+6 ;; PATCH 5: Add more variables to save: BITOTPTS, BITOTFPT, BITOTMPT ZSAVES+77
+7 ;
+8 ;
+9 ;----------
ZSAVES ;EP
+1 ;---> Single central calling point for saving BI local
+2 ;---> variables and arrays in ZTSAVE for queuing to Taskman.
+3 ;---> Any of the BI variables listed below, if defined,
+4 ;---> will be stored in the ZTSAVE array.
+5 ;---> To add additional variables or arrays, simply document
+6 ;---> in the list and add to appropriate FOR loop below.
+7 ;
+8 ;---> Variables:
+9 ;
+10 ; ZTSAVE (ret) Taskman array of saved variables and arrays.
+11 ;
+12 ; Single:
+13 ; -------
+14 ; BIACT (opt) All or ACTIVE Only in Patient Errors.
+15 ; BIAG (opt) Age Range in months.
+16 ; BIAGRP (opt) Node/number for this Age Group.
+17 ; BIAGRPS (opt) Age Groups in Two-Year-Old Report.
+18 ; BIBEGDT (opt) Begin date of report.
+19 ; BICOLL (opt) Order of Lot Number listing, 1-4.
+20 ; BICPTI (opt) 1=Include CPT Coded Visits, 0=Ignore CPT (default).
+21 ; BIDAR (opt) Adolescent Report Age Range: "11-18^1" (years).
+22 ; BIDED (opt) Include Deceased Patients (0=no, 1=yes).
+23 ; BIDELIM (opt) Delimiter (1="^", 2="2 spaces").
+24 ; BIDFN (opt) Patient's IEN in VA PATIENT File #2.
+25 ; BIDLOC (opt) Date-Location Line of letter.
+26 ; BIDLOT (opt) Display report by Lot Number (VAC).
+27 ; BIENDDT (opt) End date of report.
+28 ; BIFDT (opt) Forecast/Clinic date.
+29 ; BIFH (opt) F=report on Flu Vaccine Group, H=H1N1 group.
+30 ; BIHIST (opt) Include Historical (Vac Acct Report).
+31 ; BIHPV (opt) 1=include HepA, Pneumo & Var, 0=exclude.
+32 ; BILET (opt) IEN of Letter in BI LETTER File.
+33 ; BIMD (opt) Minimum Interval days since last letter.
+34 ; BINFO (opt) Additional Information for each patient (no longer used).
+35 ; BIORD (opt) Order of listing.
+36 ; BIPG (opt) Patient Group (see calling routine).
+37 ; BIQDT (opt) Quarter Ending Date.
+38 ; BIRDT (opt) Date Range for Received Imms (form BEGDATE:ENDDATE).
+39 ; BIRPDT (opt) Report Date in View List (if passed from reports).
+40 ; BISITE (opt) IEN of Site.
+41 ; BISUBT (opt) Subtitle String for Lot Order in BILOT.
+42 ; BITAR (opt) Two-Yr-Old Report Age Range.
+43 ; BITOTPTS(opt) Total Number of Patients.
+44 ; BITOTFPT(opt) Total Number of Female Patients.
+45 ; BITOTMPT(opt) Total Number of Male Patients.
+46 ; BIU19 (opt) Include Adults (19 yrs & over).
+47 ; BIUP (opt) User Population/Group (Registered, User, Active).
+48 ; BIVFC (opt) VFC Eligibility for Imm Visits.
+49 ; BIYEAR (opt) Report Year.
+50 ;
+51 ; Arrays:
+52 ; -------
+53 ; BIBEN (opt) Beneficiary Type array.
+54 ; BICC (opt) Current Community array.
+55 ; BICM (opt) Case Manager array.
+56 ; BIDPRV (opt) Designated Provider array.
+57 ; BIHCF (opt) Health Care Facility array.
+58 ; BILOT (opt) Lot Number array.
+59 ; BIMMD (opt) Immunization Due array.
+60 ; BIMMR (opt) Immunization Received array.
+61 ; BIMMRF (opt) Immunization Received Filter array.
+62 ; BIMMLF (opt) Lot Number Filter array.
+63 ; BINFO (opt) Additional Information for each patient.
+64 ; BIVT (opt) Visit Type array.
+65 ;
+66 ;---> Save local variables for queueing Due List/Letters.
+67 KILL ZTSAVE
NEW BISV
+68 ;
+69 FOR BISV="ACT","AG","AGRP","AGRPS","BEGDT","COLL","CPTI","DAR","DED","DELIM","DFN"
Begin DoDot:1
+70 SET BISV="BI"_BISV
+71 IF $DATA(@(BISV))
SET ZTSAVE(BISV)=""
End DoDot:1
+72 ;
+73 FOR BISV="DLOC","DLOT","ENDDT","FDT","FH","HIST","HPV","LET","MD","NFO","ORD"
Begin DoDot:1
+74 SET BISV="BI"_BISV
+75 IF $DATA(@(BISV))
SET ZTSAVE(BISV)=""
End DoDot:1
+76 ;
+77 FOR BISV="PG","QDT","RDT","RPDT","SITE","SUBT","T","TAR","TOTPTS","TOTFPT","TOTFMPT"
Begin DoDot:1
+78 SET BISV="BI"_BISV
+79 IF $DATA(@(BISV))
SET ZTSAVE(BISV)=""
End DoDot:1
+80 ;
+81 FOR BISV="U19","UP","VFC","YEAR"
Begin DoDot:1
+82 SET BISV="BI"_BISV
+83 IF $DATA(@(BISV))
SET ZTSAVE(BISV)=""
End DoDot:1
+84 ;
+85 ;---> Save local arrays for queueing Due List/Letters.
+86 FOR BISV="BEN","CC","CM","DPRV","HCF","LOT","MMD","MMLF","MMR","MMRF","VT"
Begin DoDot:1
+87 SET BISV="BI"_BISV
+88 IF $DATA(@BISV)
Begin DoDot:2
+89 NEW N
SET N=0
FOR
SET N=$ORDER(@(BISV_"("""_N_""")"))
IF N=""
QUIT
Begin DoDot:3
+90 SET ZTSAVE(BISV_"("""_N_""")")=""
End DoDot:3
End DoDot:2
End DoDot:1
+91 QUIT
+92 ;
+93 ;
+94 ;----------
ASKDATES(BIB,BIE,BIPOP,BIBDF,BIEDF,BISAME,BITIME) ;EP
+1 ;---> Ask date range.
+2 ;---> Parameters:
+3 ; 1 - BIB (ret) Begin Date, Fileman format.
+4 ; 2 - BIE (ret) End Date, Fileman format.
+5 ; 3 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
+6 ; 4 - BIBDF (opt) Begin Date default, Fileman format.
+7 ; 5 - BIEDF (opt) End Date default, Fileman format.
+8 ; 6 - BISAME (opt) Force End Date default=Begin Date.
+9 ; 7 - BITIME (opt) Ask times.
+10 ;
+11 ;---> Example:
+12 ; D ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,"T-365","T")
+13 ;
+14 SET BIPOP=0
NEW %DT,Y
+15 WRITE !!," *** Date Range Selection ***"
+16 ;
+17 ;---> Begin Date.
+18 SET %DT="APEX"_$SELECT($GET(BITIME):"T",1:"")
+19 SET %DT("A")=" Begin with DATE: "
+20 IF $GET(BIBDF)]""
SET Y=BIBDF
DO DD^%DT
SET %DT("B")=Y
+21 DO ^%DT
KILL %DT
+22 IF Y<0
SET BIPOP=1
QUIT
+23 ;
+24 ;---> End Date.
+25 SET (%DT(0),BIB)=Y
KILL %DT("B")
+26 SET %DT="APEX"_$SELECT($DATA(BITIME):"T",1:"")
+27 SET %DT("A")=" End with DATE: "
+28 IF $GET(BIEDF)]""
SET Y=BIEDF
DO DD^%DT
SET %DT("B")=Y
+29 IF $DATA(BISAME)
SET Y=BIB
DO DD^%DT
SET %DT("B")=Y
+30 DO ^%DT
KILL %DT
+31 IF Y<0
SET BIPOP=1
QUIT
+32 SET BIE=Y
+33 QUIT
+34 ;
+35 ;
+36 ;----------
DATE(BIDT,BIPOP,BIDFLT,BIPRMPT,BITIME) ;EP
+1 ;---> Ask Date.
+2 ;---> Parameters:
+3 ; 1 - BIDT (ret) Selected Date, Fileman format.
+4 ; 2 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
+5 ; 3 - BIDFLT (opt) Default, Fileman format.
+6 ; 4 - BIPRMPT (opt) Prompt.
+7 ; 5 - BITIME (opt) Ask times.
+8 ;
+9 ;---> EXAMPLE:
+10 ; D DATE^BIUTL3(.BIDT,.BIPOP,DT)
+11 ;
+12 SET BIPOP=0
NEW %DT,Y
+13 SET %DT="APEX"_$SELECT($GET(BITIME):"T",1:"")
+14 IF $GET(BIPRMPT)=""
SET BIPRMPT=" Enter DATE: "
+15 SET %DT("A")=BIPRMPT
+16 IF $GET(BIDFLT)]""
SET Y=BIDFLT
DO DD^%DT
SET %DT("B")=Y
+17 DO ^%DT
KILL %DT
+18 IF Y<0
SET BIPOP=1
QUIT
+19 SET BIDT=Y
+20 QUIT
+21 ;
+22 ;
+23 ;----------
LOCKED ;EP
+1 DO EN^DDIOL("Another user is editing this entry. Please, try again later.",,"!?5")
+2 DO DIRZ()
+3 QUIT
+4 ;
+5 ;
+6 ;----------
DIRZ(BIPOP,BIPRMT,BIPRMT1,BIPRMT2,BIPRMTQ) ;EP - Press RETURN to continue.
+1 ;---> Call to ^DIR, to Press RETURN to continue.
+2 ;---> Parameters:
+3 ; 1 - BIPOP (ret) BIPOP=1 if DTOUT or DUOUT
+4 ; 2 - BIPRMT (opt) Prompt other than "Press RETURN..."
+5 ; 3 - BIPRMT1 (opt) Prompt other than "Press RETURN..."
+6 ; 4 - BIPRMT2 (opt) Prompt other than "Press RETURN..."
+7 ; 5 - BIPRMTQ (opt) Response to "?" other than standard
+8 ;
+9 ;---> Example: D DIRZ^BIUTL3(.BIPOP)
+10 ;
+11 NEW DDS,DIR,DIRUT,X,Y,Z
+12 Begin DoDot:1
+13 IF $GET(BIPRMT)=""
Begin DoDot:2
+14 SET DIR("A")=" Press ENTER/RETURN to continue or ""^"" to exit"
End DoDot:2
QUIT
+15 SET DIR("A")=BIPRMT
+16 IF $GET(BIPRMT1)]""
SET DIR("A",1)=BIPRMT1
+17 IF $GET(BIPRMT2)]""
SET DIR("A",2)=BIPRMT2
End DoDot:1
+18 IF $GET(BIPRMTQ)]""
SET DIR("?")=BIPRMTQ
+19 SET DIR(0)="E"
WRITE !
DO ^DIR
WRITE !
+20 SET BIPOP=$SELECT($DATA(DIRUT):1,Y<1:1,1:0)
+21 QUIT
+22 ;
+23 ;
+24 ;----------
NOW1 ;EP
+1 ;---> S BITTTS=Start time.
+2 NEW %,Y,X
DO NOW^%DTC
SET BITTTS=%
+3 QUIT
+4 ;
+5 ;
+6 ;----------
NOW2 ;EP
+1 ;---> S BITTTE=End time.
+2 NEW %,Y,X
DO NOW^%DTC
SET BITTTE=%
+3 ;
+4 ;---> Compare times.
+5 SET Y=BITTTE
XECUTE ^DD("DD")
WRITE !!?5,"End : ",$PIECE(Y,"@",2)
+6 SET Y=BITTTS
XECUTE ^DD("DD")
WRITE !?5,"Begin: ",$PIECE(Y,"@",2)
+7 DO DIRZ()
+8 KILL BITTTE,BITTTS
+9 QUIT
