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

BIUTL2.m

Go to the documentation of this file. 
  1. BIUTL2 ;IHS/CMI/MWR - UTIL: ZIS, PATH, ERRCODE; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**14**;AUG 01,2017
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  UTILITY: ZIS, ERROR CODE, VACCINE NAME & GROUP,
  1.  ;;           MAX SERIES#, LOT DFLT, CASE MGR DFLT, VIS DATE DFLT.
  1.  ;;  PATCH 1: Do not provide default Lot Number if Lot Number is restricted
  1.  ;;           to a site and user's DUZ(2) does not match the site.  LOTDEF+19
  1.  ;;  PATCH 7: Changes to accommodate new TCH Forecaster   HL7TX+16
  1.  ;;  PATCH 8: Changes to accommodate new TCH Forecaster   HL7TX+16, MINAGE+6
  1.  ;;  PATCH 14: Update notes.   RISKP+0
  1.  ;
  1.  ;
  1.  ;----------
  1. ERRCD(BIIEN,BITEXT,BIDISPL,BIABBRV) ;EP
  1.  ;---> Display Error Code from BI TABLE ERROR CODE File.
  1.  ;---> Parameters:
  1.  ;     1 - BIIEN   (req) IEN of Error Code in ^BIERR(.
  1.  ;     2 - BITEXT  (ret) Text of Error Code.
  1.  ;     3 - BIDISPL (opt) BIDISPL=1 if Error Code Text SHOULD BE displayed here.
  1.  ;     4 - BIABBRV (opt) BIABBRV=1 return Abbreviated Error Text (<20 chars).
  1.  ;
  1.  ;---> Set BITEXT=Text of Error Code.
  1.  D
  1.  .I '$G(BIIEN) D  Q
  1.  ..I $G(BIABBRV) S BITEXT="No Error Code" Q
  1.  ..S BITEXT="Error Code not provided by software."
  1.  .;
  1.  .I '$D(^BIERR(BIIEN,0)) D  Q
  1.  ..I $G(BIABBRV) S BITEXT="No Error Code" Q
  1.  ..S BITEXT="Error Code does not exist in BI TABLE ERROR CODE File."
  1.  .;
  1.  .I $G(BIABBRV) S BITEXT=$P(^BIERR(BIIEN,0),"^",3) Q
  1.  .S BITEXT=$P(^BIERR(BIIEN,0),"^",2)_" #"_BIIEN
  1.  ;
  1.  ;---> Display Error Code Text.
  1.  D:$G(BIDISPL)
  1.  .N BICRT S BICRT=$S(($E($G(IOST))="C")!($G(IOST)["BROWSER"):1,1:0)
  1.  .W !!?3,BITEXT
  1.  .W:'BICRT @IOF D:BICRT DIRZ^BIUTL3()
  1.  ;
  1.  ;---> Not used for now.
  1.  ;D EN^DDIOL("* "_BITEXT,"","!!?3"),DIRZ^BIUTL3()
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. VNAME(IEN,LONG) ;EP
  1.  ;---> Return the Short, Long, or Full Name for a Vaccine.
  1.  ;---> Parameters:
  1.  ;     1 - IEN  (req) IEN of Vaccine.
  1.  ;     2 - LONG (opt) 0/null=Short Name; 1=Long Name; 2=Full Name;
  1.  ;                    3="ShortName  (LongName)."
  1.  ;
  1.  Q:'$G(IEN) "NO IEN"
  1.  Q:'$D(^AUTTIMM(IEN,0)) "UNKNOWN"
  1.  Q:$G(LONG)=1 $P(^AUTTIMM(IEN,0),"^")
  1.  Q:$G(LONG)=2 $P($G(^AUTTIMM(IEN,1)),"^",14)
  1.  Q:$G(LONG)=3 " "_$P(^AUTTIMM(IEN,0),"^",2)_"  ("_$P(^AUTTIMM(IEN,0),"^")_") "
  1.  Q $P(^AUTTIMM(IEN,0),"^",2)
  1.  ;
  1.  ;
  1.  ;----------
  1. MNAME(IEN,MVX) ;EP
  1.  ;---> Return Manufacturer Name or MVX Code.
  1.  ;---> Parameters:
  1.  ;     1 - IEN (req) IEN of Manufacturer.
  1.  ;     2 - MVX (opt) If MVX=1, return MVX Code
  1.  ;
  1.  Q:'$G(IEN) "NO IEN"
  1.  Q:'$D(^AUTTIMAN(IEN,0)) $S($G(MVX):"UNK",1:"UNKNOWN")
  1.  Q:$G(MVX)=1 $P(^AUTTIMAN(IEN,0),"^",2)
  1.  Q $P(^AUTTIMAN(IEN,0),"^")
  1.  ;
  1.  ;
  1.  ;----------
  1. CODE(IEN,TYPE) ;EP
  1.  ;---> Return the HL7-CVX, CPT, ICD Diagnosis, or ICD Procedure Code
  1.  ;---> for a Vaccine.
  1.  ;---> Parameters:
  1.  ;     1 - IEN  (req) IEN of Vaccine.
  1.  ;     2 - TYPE (opt) TYPE of Code to return:
  1.  ;                        1=HL7-CVX (also default)
  1.  ;                        2=CPT
  1.  ;                        3=ICD Diagnosis
  1.  ;                        4=ICD Procedure
  1.  ;                        5=Volume Default
  1.  ;                        6=HL7-CVX w/leading zero
  1.  ;
  1.  Q:'$G(IEN) "NO IEN"
  1.  Q:'$D(^AUTTIMM(IEN,0)) "UNKNOWN"
  1.  ;
  1.  Q:$G(TYPE)=2 $P(^AUTTIMM(IEN,0),"^",11)
  1.  Q:$G(TYPE)=3 $P(^AUTTIMM(IEN,0),"^",14)
  1.  Q:$G(TYPE)=4 $P(^AUTTIMM(IEN,0),"^",15)
  1.  Q:$G(TYPE)=5 $P(^AUTTIMM(IEN,0),"^",18)
  1.  N X S X=$P(^AUTTIMM(IEN,0),"^",3)
  1.  I $G(TYPE)=6,$L(X)=1 S X=0_X
  1.  Q X
  1.  ;
  1.  ;
  1.  ;----------
  1. IMMVG(BIIEN,Z) ;EP
  1.  ;---> For a particular Vaccine, return its Vaccine Group Information.
  1.  ;---> (Note: Vaccine Group is also called "Series Type."
  1.  ;---> .
  1.  ;---> Parameters:
  1.  ;     1 - BIIEN  (req) IEN in of Vaccine in IMMUNIZATION File #9999999.14.
  1.  ;     2 - Z      (opt) If Z=1, return Vaccine Group FULL NAME.
  1.  ;                      If Z=2, return Vaccine Group IEN (default if no Z).
  1.  ;                      If Z=3, return Vaccine Group Forecast indicator:
  1.  ;                              1=ON, 0=OFF
  1.  ;                      If Z=4, return Display Order for reports.
  1.  ;                      If Z=5, return SHORT NAME of Vaccine Group.
  1.  ;
  1.  ;---> Default: Return IEN of Vaccine Group.
  1.  S:'$G(Z) Z=2
  1.  N BIVG,BIVG0
  1.  ;
  1.  ;---> If any values or pointers are null, set Vaccine Group IEN=12: "Other".
  1.  D
  1.  .I '$G(BIIEN) S BIVG=12 Q
  1.  .I '$D(^AUTTIMM(BIIEN,0)) S BIVG=12 Q
  1.  .S BIVG=$P(^AUTTIMM(BIIEN,0),U,9)
  1.  .S:'BIVG BIVG=12
  1.  ;
  1.  I Z=2 Q BIVG
  1.  Q $$VGROUP(BIVG,Z)
  1.  ;
  1.  ;
  1.  ;----------
  1. VGROUP(BIVG,Z) ;EP
  1.  ;---> Return Vaccine Group or ("Series Type") or Information
  1.  ;---> for a particular Vaccine Group.
  1.  ;---> Parameters:
  1.  ;     1 - BIVG  (req) IEN in BI TABLE VACCINE GROUP File #9002084.93.
  1.  ;     2 - Z     (opt) If Z=1, return Vaccine Group FULL NAME (default if no Z).
  1.  ;                     If Z=3, return Vaccine Group Forecast indicator:
  1.  ;                             1=ON, 0=OFF
  1.  ;                     If Z=4, return Display Order for reports.
  1.  ;                     If Z=5, return SHORT NAME of Vaccine Group.
  1.  ;                     If Z=6, return max doses in Quarterly/Two-Yr-Old Reports.
  1.  ;                     If Z=7, return max doses in Adolescent Report.
  1.  ;                     If Z=8, return Vaccine Group Two-Yr-Old Report indicator:
  1.  ;                             1=Yes,include; 0=No, exclude.
  1.  ;
  1.  ;---> If null, set Vaccine Group IEN=12: "Other".
  1.  S:'$G(BIVG) BIVG=12
  1.  S BIVG0=$G(^BISERT(BIVG,0))
  1.  S:BIVG0="" BIVG=12,BIVG0=$G(^BISERT(BIVG,0))
  1.  ;
  1.  S:('$G(Z)) Z=1
  1.  I Z=3 Q +$P(BIVG0,U,5)
  1.  I Z=4 Q +$P(BIVG0,U,2)
  1.  I Z=5 Q $P(BIVG0,U,3)
  1.  I Z=6 Q $P(BIVG0,U,4)
  1.  I Z=7 Q $P(BIVG0,U,7)
  1.  I Z=8 Q $P(BIVG0,U,8)
  1.  Q $P(BIVG0,U)
  1.  ;
  1.  ;
  1.  ;----------
  1. HL7TX(BICVX,BIGRP) ;EP
  1.  ;---> Return the IEN of a Vaccine, given its HL7 Code.
  1.  ;---> If lookup fails, return 137 for "OTHER".
  1.  ;---> Parameters:
  1.  ;     1 - BICVX  (req) CVX Code for this vaccine.
  1.  ;     2 - BIGRP  (opt) If BIGRP=1, return Vaccine Group IEN for this CVX.
  1.  ;
  1.  I '$G(BICVX) S BICVX=999
  1.  I '$D(^AUTTIMM("C",BICVX)) S BICVX=999
  1.  N BIVIEN S BIVIEN=$O(^AUTTIMM("C",BICVX,0))
  1.  S:'BIVIEN BIVIEN=137
  1.  ;---> Return Vaccine IEN for this CVX.
  1.  Q:'$G(BIGRP) BIVIEN
  1.  ;---> Return Vaccine Group for this CVX.
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> If the Vaccine Group is null, return IEN for Group "OTHER".
  1.  ;Q $P(^AUTTIMM(BIVIEN,0),"^",9)
  1.  N X S X=$P(^AUTTIMM(BIVIEN,0),"^",9)
  1.  S:'X X=12
  1.  Q X
  1.  ;**********
  1.  ;
  1.  ;
  1.  ;----------
  1. VCOMPS(IEN) ;EP v8.0
  1.  ;---> Return string of components IEN's for a Vaccine.
  1.  ;---> Parameters:
  1.  ;     1 - IEN  (req) IEN of Vaccine.
  1.  ;
  1.  Q:'$G(IEN) ""
  1.  Q:'$D(^AUTTIMM(IEN,0)) ""
  1.  N X S X=$P(^AUTTIMM(IEN,0),"^",21,26)
  1.  S X=$TR(X,"^",";")
  1.  Q X
  1.  ;
  1.  ;
  1.  ;----------
  1. LOTDEF(IEN) ;EP
  1.  ;---> Return the IEN of the Default Lot# for a Vaccine.
  1.  ;---> Parameters:
  1.  ;     1 - IEN  (req) IEN of Vaccine in IMMUNIZATION File (9999999.14).
  1.  ;
  1.  Q:'$G(IEN) ""
  1.  Q:'$D(^AUTTIMM(IEN,0)) ""
  1.  N X,Y S X=$P(^AUTTIMM(IEN,0),"^",4)
  1.  ;
  1.  ;---> Quit if no Default Lot# stored.
  1.  Q:'X ""
  1.  ;---> Quit if pointed to Lot# does not exist.
  1.  S Y=$G(^AUTTIML(X,0))
  1.  Q:Y="" ""
  1.  ;---> Quit if this Lot# does NOT point back to this Vaccine.
  1.  Q:$P(Y,U,4)'=IEN ""
  1.  ;---> Quit if this Lot# is INACTIVE.
  1.  Q:$P(Y,U,3) ""
  1.  ;
  1.  ;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
  1.  ;---> Quit if this Lot# has a Facility and User's DUZ(2) does not match.
  1.  Q:(($P(Y,U,14))&($P(Y,U,14)'=$G(DUZ(2)))) ""
  1.  ;**********
  1.  ;
  1.  ;---> Return Default Lot# IEN.
  1.  Q X
  1.  ;
  1.  ;
  1.  ;----------
  1. LOTREQ(BIDUZ2) ;EP
  1.  ;---> Return 1 if Lot#'s are required, 0 if not.
  1.  ;---> Parameters:
  1.  ;     1 - BIDUZ2 (req) User's DUZ(2)
  1.  ;
  1.  Q $P($G(^BISITE(+$G(BIDUZ2),0)),U,9)
  1.  ;
  1.  ;
  1.  ;----------
  1. LOTLOW(BILIEN,BIDUZ2) ;EP
  1.  ;---> Return the number of (remaining) doses of a Lot Number
  1.  ;---> that will trigger a Low Supply Alert.
  1.  ;---> If not set for this site, 50 will be returned.
  1.  ;---> Parameters:
  1.  ;     1 - BILIEN  (req) IEN of Lot Number in ^AUTTIML.
  1.  ;     2 - BIDUZ2 (req) User's DUZ(2)
  1.  ;                                         vvv83
  1.  N X
  1.  D
  1.  .S X=$P($G(^AUTTIML(+BILIEN,0)),U,15)  Q:X
  1.  .S X=$P($G(^BISITE(+$G(BIDUZ2),0)),U,25)
  1.  S:(X="") X=50
  1.  Q X
  1.  ;
  1.  ;
  1.  ;----------
  1. FORECAS(BIDUZ2) ;EP
  1.  ;---> Return 1 if Forecasting is enabled.
  1.  ;---> Parameters:
  1.  ;     1 - BIDUZ2 (req) User's DUZ(2)
  1.  ;
  1.  Q $P($G(^BISITE(+$G(BIDUZ2),0)),U,11)
  1.  ;
  1.  ;
  1.  ;----------
  1. INPTCHK(BIDUZ2) ;EP
  1.  ;---> Return 1 if Inpatient Visit Check is enabled.
  1.  ;---> Parameters:
  1.  ;     1 - BIDUZ2 (req) User's DUZ(2)
  1.  ;
  1.  Q $P($G(^BISITE(+$G(BIDUZ2),0)),U,23)
  1.  ;
  1.  ;
  1.  ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
  1.  ;---> Update notes below.
  1.  ;----------
  1. RISKP(BIDUZ2) ;EP - Risk Factor check (and smoking).
  1.  ;---> Risk Parameter: 0 - None, 1 - Pneumo for High Risk history,
  1.  ;--->  2 - Hep B for Diabetes Mellitus, 3 - Hep A and Hep B for CLD/Hep C
  1.  ;--->  9 - adds Smoking Factors.
  1.  ;---> Parameters:
  1.  ;     1 - BIDUZ2 (req) User's DUZ(2)
  1.  ;
  1.  Q +$P($G(^BISITE(+$G(BIDUZ2),0)),U,19)
  1.  ;**********
  1.  ;
  1.  ;
  1.  ;----------
  1. IMPCPT(BIDUZ2) ;EP
  1.  ;---> Return 1 if Import of CPT-coded Visits is enabled.
  1.  ;---> Parameters:
  1.  ;     1 - BIDUZ2 (req) User's DUZ(2)
  1.  ;
  1.  Q $P($G(^BISITE(+$G(BIDUZ2),0)),U,20)
  1.  ;
  1.  ;
  1.  ;----------
  1. VISMNU(BIDUZ2) ;EP
  1.  ;---> Visit Selection Menu Parameter: Return 1 to display a menu of matching
  1.  ;---> Visits, if any; return 0 to automatically create or link Visits.
  1.  ;---> Parameters:
  1.  ;     1 - BIDUZ2 (req) User's DUZ(2)
  1.  ;
  1.  Q +$P($G(^BISITE(+$G(BIDUZ2),0)),U,28)
  1.  ;
  1.  ;
  1.  ;----------
  1. CMGRACT(BICMGR) ;EP
  1.  ;---> Return 1 if the Case Manager is INACTIVE.
  1.  ;---> Parameters:
  1.  ;     1 - BICMGR (req) IEN of Case Manager.
  1.  ;
  1.  Q:'$G(BICMGR) 1
  1.  Q:'$D(^BIMGR(BICMGR,0)) 1
  1.  Q $P(^BIMGR(BICMGR,0),U,2)
  1.  ;
  1.  ;
  1.  ;----------
  1. CMGRDEF(DUZ2,X) ;EP
  1.  ;---> Return Default Case Manager for this site.
  1.  ;---> Parameters:
  1.  ;     1 - DUZ2 (req) User's DUZ(2)
  1.  ;     2 - X    (opt) X=1 to return TEXT of default Case Manager name.
  1.  ;
  1.  Q:'$G(DUZ2) ""
  1.  N Y S Y=$P($G(^BISITE(DUZ2,0)),U,2)
  1.  Q:'Y ""
  1.  Q:'$D(^BIMGR(Y,0)) ""
  1.  Q:'$G(X) Y
  1.  Q:$$CMGRACT(Y) $E($$PERSON^BIUTL1(Y),1,20)_" * INACTIVE!"
  1.  Q $$PERSON^BIUTL1(Y)
  1.  ;
  1.  ;
  1.  ;----------
  1. DEFLET(DUZ2,X,Z) ;EP
  1.  ;---> Return Default Letters (Standard Due Letter,
  1.  ;---> Official Imm Record).
  1.  ;---> Parameters:
  1.  ;     1 - DUZ2 (req) User's DUZ(2)
  1.  ;     2 - X    (opt) X=1 to return TEXT of default Due Letter.
  1.  ;     3 - Z    (opt) Z="" returns Standard Due Letter.
  1.  ;                    Z=1 returns Official Immunization Record.
  1.  ;
  1.  Q:'$G(DUZ2) ""
  1.  N Y S Y=$P($G(^BISITE(DUZ2,0)),U,$S($G(Z):13,1:4))
  1.  Q:'$G(X) Y
  1.  Q:'Y ""
  1.  Q $P($G(^BILET(Y,0)),U)
  1.  ;
  1.  ;
  1.  ;----------
  1. MINDAYS(DUZ2) ;EP
  1.  ;---> Return Default Minimum Days Since Last Letter sent
  1.  ;---> for this site.
  1.  ;---> Parameters:
  1.  ;     1 - DUZ2 (req) User's DUZ(2)
  1.  ;
  1.  Q:'$G(DUZ2) 60
  1.  N Y S Y=$P($G(^BISITE(DUZ2,0)),U,5)
  1.  Q:Y="" 60
  1.  Q Y
  1.  ;
  1.  ;
  1.  ;----------
  1. MINAGE(DUZ2) ;EP
  1.  ;---> Return parameter to forecast immunizations due at either the
  1.  ;---> Minimum Acceptable Age or at the Recommended Age for this site.
  1.  ;---> Parameters:
  1.  ;     1 - DUZ2 (req) User's DUZ(2)
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Change returned value to 1 or 0 to accommodate new forecaster.
  1.  Q:'$G(DUZ2) 0
  1.  Q:($P($G(^BISITE(DUZ2,0)),U,7)="A") 1
  1.  Q 0
  1.  ;**********
  1.  ;
  1.  ;
  1.  ;----------
  1. RULES(DUZ2) ;EP
  1.  ;---> Return parameter indicating which set of Immserve Forecasting
  1.  ;---> Rules is being used (passed to Immserve).
  1.  ;---> Parameters:
  1.  ;     1 - DUZ2 (req) User's DUZ(2)
  1.  ;
  1.  N Y S Y=$$VALIDRUL(DUZ2)
  1.  Q:'Y "IHS_1m18"
  1.  Q "IHS_"_Y
  1.  ;
  1.  ;
  1.  ;----------
  1. VALIDRUL(DUZ2) ;EP
  1.  ;---> Return whether current Immserve Site Parameter is a valid choice.
  1.  ;---> Return 0 is NOT a valid choice; otherwise return the numeric choice.
  1.  ;---> Parameters:
  1.  ;     1 - DUZ2 (req) User's DUZ(2)
  1.  ;
  1.  Q:'$G(DUZ2) 0
  1.  N X,Y
  1.  S Y=$G(^BISITE(DUZ(2),0)),X=$P(Y,U,8)
  1.  ;---> For a new set of Immserve Rules, change here below and $$RULES+10^BISITE2.
  1.  ;---> Current valid choices are 1,2,3,4,5,11.
  1.  Q:((X<1)!(X>11)) 0
  1.  Q:((X>7)&(X<11)) 0
  1.  Q X_$S($P(Y,U,21):"g",1:"")_$S($P(Y,U,24)=2:"m26",1:"m18")
  1.  ;
  1.  ;
  1.  ;----------
  1. VISDEF(IEN) ;EP
  1.  ;---> Return the Default Date of the Vaccine Information Statement
  1.  ;---> (VIS) for this vaccine (Fileman format).
  1.  ;---> Parameters:
  1.  ;     1 - IEN  (req) IEN of Vaccine in IMMUNIZATION File (9999999.14).
  1.  ;
  1.  Q:'$G(IEN) ""
  1.  Q:'$D(^AUTTIMM(IEN,0)) ""
  1.  Q $P(^AUTTIMM(IEN,0),"^",13)
  1.  ;
  1.  ;
  1.  ;----------
  1. ZIS(BIPOP,BIQUE,BIDEF,BIPRMPT,BIMES) ;EP
  1.  ;---> Call to ^%ZIS
  1.  ;---> Parameters:
  1.  ;     1 - BIPOP         (ret) BIPOP=1 if POP=1 (fail or quit).
  1.  ;     2 - BIQUE=1       (opt) SET=1 if job should be queueable.
  1.  ;     3 - BIDEF=DEFAULT (opt) If exists, equals Default DEVICE.
  1.  ;     4 - BIPRMPT       (opt) If exists, equals PROMPT.
  1.  ;     5 - BIMES         (opt) A message to display if QUEUED.
  1.  ;
  1.  ;---> Example: D ZIS^BIUTL2(.BIPOP,1,"HOME")
  1.  ;
  1. ZIS1 ;EP for loop back from failed BIQUE.
  1.  S BIPOP=0
  1.  ;
  1.  ;---> BIPRMPT=BIPRMPT.
  1.  S %ZIS("A")=$S($D(BIPRMPT):BIPRMPT,1:"   Select DEVICE: ")
  1.  ;
  1.  ;---> BIDEF=DEFAULT PRINTER.
  1.  ;---> IF NO BIDEF, SET BIDEF="P" FOR CLOSEST PRINTER.
  1.  D
  1.  .I '$D(BIDEF) S %ZIS="P" Q
  1.  .S %ZIS("B")=BIDEF,%ZIS=""
  1.  ;
  1.  ;---> If BIQUE=1,job may be queued.
  1.  I $G(BIQUE)]"" I BIQUE S %ZIS=%ZIS_"Q"
  1.  ;
  1.  W ! D ^%ZIS S:POP BIPOP=1
  1.  ;---> Quit if BIPOP (DUOUT or DTOUT) or if not queued.
  1.  G:BIPOP!('$D(IO("Q"))) ZISEXIT
  1.  ;
  1.  I IO=IO(0) W !?5,"Cannot queue to screen or slave printer!",! G ZIS1
  1.  ;
  1.  ;---> NEXT LINE: Line Label "ZISQ" added for entry where Device
  1.  ;---> Info has already been adked and User queued output.
  1. ZISQ ;EP
  1.  ;---> NEXT LINES: Job was queued, therefore set BIPOP=1 so that the
  1.  ;---> calling routine will quit (and let Taskman finish this job).
  1.  S BIPOP=1
  1.  I '$D(ZTRTN) D  G ZISEXIT
  1.  .W !?5,*7,"NO ROUTINE NAMED FOR QUEUEING -- CONTACT PROGRAMMER."
  1.  I '$D(ZTDESC) S ZTDESC=ZTRTN
  1.  S BIMES=$S($D(BIMES):BIMES,1:"W !?5,""Request Queued."",!")
  1.  ;
  1.  S ZTIO=$S($D(ION):ION,1:"")
  1.  I ZTIO]"" D
  1.  .I $D(IO("DOC")) S ZTIO=ZTIO_";"_IOST_";"_IO("DOC") Q
  1.  .S ZTIO=ZTIO_";"_IOST_";"_IOM_";"_IOSL
  1.  ;
  1.  ;---> Uncomment next line to suppress "Requested Start Time" question.
  1.  ;S ZTDTH=$H
  1.  D ^%ZTLOAD,^%ZISC
  1.  X:$D(ZTQUEUED) BIMES H 2
  1.  ;
  1. ZISEXIT ;EP
  1.  K BIMES,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DFNCHECK() ;EP
  1.  ;---> If BIDFN not supplied, set Error Code and quit.
  1.  I '$G(BIDFN) D ERRCD^BIUTL2(201,,1) Q 1
  1.  Q 0
  1.  ;
  1.  ;
  1.  ;----------
  1. DUZCHECK() ;EP
  1.  ;---> If no BIDUZ2 (Site IEN), Set it equal to User's DUZ(2).
  1.  ;---> If User's DUZ(2) fails, set Error Code and quit.
  1.  S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
  1.  I '$G(BIDUZ2) D ERRCD^BIUTL2(105,,1) Q 1
  1.  Q 0
  1.  ;
  1.  ;
  1. VMAX(IEN) ;EP  ;MWRZZZ REMOVE?
  1.  ;---> Return the Maximum Dose# for a Vaccine.
  1.  ;---> Parameters:
  1.  ;     1 - IEN  (req) IEN of Vaccine.
  1.  ;
  1.  Q ""
  1.  Q $P(^AUTTIMM(IEN,0),"^",5)