- 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