Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BIUTL3

BIUTL3.m

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