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