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

BIUTL11.m

Go to the documentation of this file. 
  1. BIUTL11 ;IHS/CMI/MWR - UTIL: PATIENT INFO; AUG 10,2010
  1.  ;;8.5;IMMUNIZATION;**9**;OCT 01,2014
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  UTILITY: PATIENT FUNCTIONS: CONTRAS, INPATIENT, HIDOSE.
  1.  ;;  PATCH 1: Correct typo "Q", so that unmatched CVX returns 0 (zero),
  1.  ;;           not "Q".  LASTIMM+17
  1.  ;;  PATCH 3: Append date to Hx of Chickenpox Reason.  CONTRA+45
  1.  ;;  PATCH 5: Unused call, was never a P.E.P..  CONTR+0
  1.  ;;  PATCH 8: For Hx of Chicken Pox, do NOT contraindicate Zoster (CVX=121). CONTRA+62
  1.  ;;  PATCH 9: Add GOTDOSE call: check if patient received a dose.  GOTDOSE+0
  1.  ;
  1.  ;
  1.  ;----------
  1. CONTRA(BIDFN,A,BIREF,BIDATE) ;EP
  1.  ;---> Return an array of a patient's ImmServe Contraindications.
  1.  ;---> Called by IMMSERV^BIEXPRT5.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN (req)  Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - A     (ret)  Array with subscripts=HL7 CVX Codes of vaccines
  1.  ;                      contraindicated for this patient.
  1.  ;                      Each node A(CVX)=IEN of the Reason in ^BICONT(
  1.  ;     3 - BIREF (opt)  If BIREF=1, return only Vaccines contraindicated
  1.  ;                      because they were refused, i.e., Refusals.
  1.  ;                      If BIREF=2, return only Vaccines contraindicated
  1.  ;                      because of Hx of Chicken Pox.
  1.  ;     4 - BIDATE (opt) If BIDATE=1, append Date of contra to Refusals.
  1.  ;
  1.  Q:'$G(BIDFN)
  1.  ;---> Quit if there are no contraindications for this patient.
  1.  Q:'$D(^BIPC("B",BIDFN))
  1.  ;
  1.  N N,U S N=0,U="^"
  1.  F  S N=$O(^BIPC("B",BIDFN,N)) Q:'N  D
  1.  .;---> If bad xref, kill it and quit.
  1.  .I '$D(^BIPC(N,0)) K ^BIPC("B",BIDFN,N) Q
  1.  .N BIPC,X,Y
  1.  .;---> BIPC=zero node of a Patient's Contraindication.
  1.  .S BIPC=^BIPC(N,0)
  1.  .;
  1.  .;---> Set X=Reason pointer (to ^BICONT), Y=Date of Contraindication.
  1.  .S X=$P(BIPC,U,3),Y=$P(BIPC,U,4)
  1.  .;
  1.  .;---> If the call is to return an array of Refusals, do so and quit.
  1.  .I $G(BIREF)=1 D  Q
  1.  ..;---> 11 & 16 are IENs of BI TABLE CONTRA REASONS ^BICONT( that are REFUSALS.
  1.  ..I (X=11)!(X=16) D  Q
  1.  ...;---> Set array node A(CVX)=IEN of Refusal Contra Reason.
  1.  ...N Z S Z=$P(BIPC,U,2) I Z S Z=$G(^AUTTIMM(Z,0)),Z=$P(Z,U,3)
  1.  ...I Z S A(Z)=X S:$G(BIDATE) A(Z)=A(Z)_U_Y
  1.  .;
  1.  .;
  1.  .;---> If the call is to return an array of Hx of Chicken Pox, do so and quit.
  1.  .I $G(BIREF)=2 D  Q
  1.  ..;---> 12 is the IEN of BI TABLE CONTRA REASONS that is Hx of Chicken Pox.
  1.  ..I X=12 D  Q
  1.  ...;---> Set array node A(CVX)=IEN of Hx of Chicken Pox Reason.
  1.  ...;
  1.  ...;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
  1.  ...;---> Append date to Hx of Chickenpox Reason.
  1.  ...N Z S Z=$P(BIPC,U,2) I Z S Z=$G(^AUTTIMM(Z,0)),Z=$P(Z,U,3)
  1.  ...I Z S A(Z)=X S:$G(BIDATE) A(Z)=A(Z)_U_Y
  1.  ...;**********
  1.  .;
  1.  .;---> Continue in order to return an array of contra'd vaccines by CVX Code.
  1.  .;
  1.  .;---> Quit if the Reason for this contraindication is one that
  1.  .;---> still allows forecasting of the vaccine.  For example,
  1.  .;---> if the reason is "Patient Refusal", then the vaccine should
  1.  .;---> still be forecast as due.
  1.  .I X Q:$P($G(^BICONT(X,0)),U,2)
  1.  .;
  1.  .;---> For this Vaccine IEN contraindication, get Related Contraindcated CVX Codes.
  1.  .;---> (Call below also sets A(CVX) of THIS Vaccine IEN in the A(CVX) array.)
  1.  .D CONTRHL7($P(BIPC,U,2),.A)
  1.  .;
  1.  .;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  .;---> If the vaccine is Varicella (CVX=21) and Reason is Hx of Chicken Pox,
  1.  .;---> do NOT contraindicate Zoster (CVX=121).
  1.  .I $P(BIPC,U,2)=132,$P(BIPC,U,3)=12 K A(121)
  1.  .;**********
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. CONTRHL7(BIVAC,A) ;EP
  1.  ;---> Return an array of Related Contraindcated HL7 Codes for
  1.  ;---> this vaccine.
  1.  ;---> Parameters:
  1.  ;     1 - BIVAC (req) IEN of Vaccine.
  1.  ;     2 - A     (ret) Array with subscripts=HL7 Codes of vaccines
  1.  ;                     contraindicated that relate to this vaccine.
  1.  ;
  1.  Q:'$G(BIVAC)  Q:'$D(^AUTTIMM(BIVAC,0))
  1.  ;
  1.  ;---> Set X=data for this vaccine.
  1.  N X S X=^AUTTIMM(BIVAC,0)
  1.  ;
  1.  ;---> Set HL7 Code for this contraindicated vaccine in A() array
  1.  ;---> as a subscript.
  1.  Q:'$P(X,U,3)
  1.  S A($P(X,U,3))=""
  1.  ;
  1.  ;---> Set X=string of Related Contraindicated HL7 Codes for this
  1.  ;---> vaccine.
  1.  S X=$P(X,U,12)
  1.  ;
  1.  ;---> Now piece out Contraindicated HL7 Codes (comma delimited)
  1.  ;---> and set in A() array as subscripts.
  1.  N I,Y F I=1:1 S Y=$P(X,",",I) Q:'Y  S A(Y)=""
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. CONTR(BIDFN,BIVAC) ;EP
  1.  ;
  1.  ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1.  ;---> REMOVED. Was never a P.E.P.
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. INPT(BIDFN,BIDATE) ;EP
  1.  ;---> Return 1 if patient was an inpatient on BIDATE.
  1.  ;---> Called by +84^BIVISIT to correct Category.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - BIDATE (req) Date to check if patient was inpatient.
  1.  ;
  1.  Q:'$G(BIDFN) 0  Q:'$G(BIDATE) 0
  1.  ;
  1.  ;---> Get last discharge previous to BIDATE.
  1.  N X,Y S BIDATE=9999999.9999999-BIDATE
  1.  S X=$O(^AUPNVINP("AA",BIDFN,BIDATE))
  1.  ;
  1.  ;---> Now check to see if patient has been admitted since
  1.  ;---> that discharge date.
  1.  S X=$O(^AUPNVSIT("AAH",BIDFN,X),-1)
  1.  ;
  1.  ;---> If patient not admitted since last discharge, quit 0.
  1.  Q:'X 0
  1.  ;
  1.  ;---> If Visit is for Contract Care, quit 0 (not an inpatient).
  1.  ;---> Next line v8.1 fix: Use X (inv date) to get Y (IEN).
  1.  S Y=+$O(^AUPNVSIT("AAH",BIDFN,X,0))
  1.  Q:$P($G(^AUPNVSIT(Y,0)),U,3)="C" 0
  1.  ;
  1.  ;---> If last admission was after BIDATE (inverse), quit 0.
  1.  Q:X<BIDATE 0
  1.  ;
  1.  ;---> Patient was an inpatient on BIDATE, quit 1.
  1.  Q 1
  1.  ;
  1.  ;
  1.  ;----------
  1. INFL(BIDFN,TEXT) ;EP
  1.  ;---> Return value of Patient's Forecast Influ/Pneumo field.
  1.  ;---> 0=Normal, 1=Influenza, 2=Pneumococcal, 3=Both, 4=Disregard Risk Factors.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN (BIDFN).
  1.  ;     2 - TEXT (opt) If TEXT=1, return text of the field.
  1.  ;
  1.  Q:'$G(BIDFN) 0
  1.  Q:'$D(^BIP(BIDFN,0)) 0
  1.  N X S X=+$P(^BIP(BIDFN,0),U,15)
  1.  Q:'$G(TEXT) X
  1.  Q:X=4 "Disregard Risk Factors"
  1.  Q:X=3 "Influenza and Pneumo"
  1.  Q:X=2 "Pneumococcal"
  1.  Q:X=1 "Influenza"
  1.  Q "Normal"
  1.  ;
  1.  ;
  1.  ;----------
  1. MOTHER(BIDFN,BITEXT) ;EP
  1.  ;---> Return mother's HBsAg Status Code.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN    (req) Patient's IEN (BIDFN).
  1.  ;     2 - BITEXT (opt) If BITEXT=1 return full text.
  1.  N X
  1.  D
  1.  .I '$G(BIDFN) S X="U" Q
  1.  .I '$D(^BIP(BIDFN,0)) S X="U" Q
  1.  .S X=$P(^BIP(BIDFN,0),U,11)
  1.  S:X="" X="U"
  1.  Q:'$G(BITEXT) X
  1.  Q $S(X="P":"POSITIVE",X="N":"NEGATIVE",1:"UNKNOWN")
  1.  ;
  1.  ;
  1.  ;----------
  1. BENTYP(BIDFN,TEXT) ;EP
  1.  ;---> Return IEN of Patient's Beneficiary Type.
  1.  ;---> This is the CLASSIFICATION/BENEFICIARY Code (Item 2 on page 2
  1.  ;---> of Registration).
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN (req) Patient's IEN (DFN).
  1.  ;---> Text parameter added.
  1.  ;     2 - TEXT  (opt) If TEXT=1, return text of Beneficiary Type.
  1.  ;                     If text=2, return Code of Beneficiary Type.  vvv83
  1.  ;
  1.  N Y
  1.  Q:'$G(BIDFN) 0
  1.  S Y=+$P($G(^AUPNPAT(BIDFN,11)),U,11)
  1.  Q:'$G(TEXT) Y
  1.  Q:$G(TEXT)=2 $P($G(^AUTTBEN(Y,0)),U,2)  ;vvv83
  1.  Q $P($G(^AUTTBEN(Y,0)),U)
  1.  ;
  1.  ;
  1.  ;----------
  1. OTHERIN(BIDFN) ;EP
  1.  ;---> Return Patient's Other Info.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN (BIDFN).
  1.  ;
  1.  Q:'$G(BIDFN) ""
  1.  Q $P($G(^BIP(BIDFN,0)),U,13)
  1.  ;
  1.  ;
  1.  ;----------
  1. MAYEDIT() ;EP
  1.  ;---> Return 1 if User has Immunization Edit Patients Key; 0 if not.
  1.  Q:'$D(DUZ) 0
  1.  Q:$D(^XUSEC("BIZ EDIT PATIENTS",DUZ)) 1
  1.  Q:$D(^XUSEC("BIZ MANAGER",DUZ)) 1
  1.  Q 0
  1.  ;
  1.  ;
  1.  ;----------
  1. MAYMANAG() ;EP
  1.  ;---> Return 1 if User has Immunization Manager Key; 0 if not.
  1.  Q:'$D(DUZ) 0
  1.  Q:$D(^XUSEC("BIZ MANAGER",DUZ)) 1
  1.  Q 0
  1.  ;
  1.  ;
  1.  ;----------
  1. CURCOM(BIDFN,TEXT) ;EP
  1.  ;---> Return patient's Current Community IEN or Text.
  1.  ;---> (Item 6 on page 1 of Registration).
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN (BIDFN).
  1.  ;     2 - TEXT (opt) If TEXT=1, return text of Current Community.
  1.  ;
  1.  Q:'$G(BIDFN) "No Patient"
  1.  Q:'$D(^AUPNPAT(BIDFN,11)) "Unknown1"
  1.  ;
  1.  N X,Y,Z
  1.  S X=^AUPNPAT(BIDFN,11)
  1.  ;---> Set Y=Pointer (IEN in ^AUTTCOM, piece 17), Z=Text (piece 18).
  1.  S Y=$P(X,U,17),Z=$P(X,U,18)
  1.  ;---> If both Pointer and Text are null, return "Unknown2".
  1.  Q:('Y&(Z="")) "Unknown2"
  1.  ;
  1.  ;---> If Y is null or a bad pointer, set Y="".
  1.  I Y<1!('$D(^AUTTCOM(+Y,0))) S Y=""
  1.  ;
  1.  ;---> If no valid pointer and if Text (pc 18) exists in the
  1.  ;---> Community file, then set Y=IEN in ^AUTTCOM(, and fix it.
  1.  I Y<1,$D(^AUTTCOM("B",Z)) S Y=$O(^AUTTCOM("B",Z,0)) D
  1.  .N BIFLD S BIFLD(1117)=Y D FDIE^BIFMAN(9000001,BIDFN,.BIFLD)
  1.  ;
  1.  Q:'$D(^AUTTCOM(+Y,0)) "Unknown3"
  1.  ;
  1.  N BITEXT S BITEXT=$P(^AUTTCOM(Y,0),U)
  1.  ;---> If text field is off, fix it.
  1.  I Z'=BITEXT D
  1.  .N BIFLD S BIFLD(1118)=BITEXT D FDIE^BIFMAN(9000001,BIDFN,.BIFLD)
  1.  Q:'$G(TEXT) Y
  1.  Q $P(^AUTTCOM(Y,0),U)
  1.  ;
  1.  ;
  1.  ;----------
  1. ISGPRA(BIDFN,BISITE,BINOCOM,BIERR) ;PEP - Return 1 if Pt's Current Community is in Imm GPRA Set.
  1.  ;---> Return 1 if Patient's Current Community is in the Immunization GPRA Set
  1.  ;---> of Communities as defined in the BI Site Parameters File.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req) Patient's IEN (BIDFN).
  1.  ;     2 - BISITE  (req) IEN of Site (often the user's DUZ(2)).
  1.  ;
  1.  N BIPCC,BIGPRA,BIERR S BIERR=""
  1.  I '$G(BIDFN) D ERRCD^BIUTL2(201,.BIERR) Q 0
  1.  S:'$G(BISITE) BISITE=$G(DUZ(2))
  1.  I '$G(BISITE) D ERRCD^BIUTL2(109,.BIERR) Q 0
  1.  S BIPCC=+$$CURCOM(BIDFN)
  1.  Q:'BIPCC 0
  1.  D GETGPRA^BISITE4(.BIGPRA,BISITE,.BIERR)
  1.  I BIERR]"" Q 0
  1.  Q:$D(BIGPRA(BIPCC)) 1
  1.  Q 0
  1.  ;
  1.  ;
  1.  ;----------
  1. NEXTAPPT(BIDFN) ;EP
  1.  ;---> Return patient's next appointment from Scheduling Package.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN (BIDFN).
  1.  ;
  1.  Q:'$G(BIDFN) ""
  1.  Q:'$D(^DPT(BIDFN)) ""
  1.  ;
  1.  N BIAPPT,BIDT,BIYES
  1.  S BIDT=DT+.2400,BIYES=0
  1.  F  S BIDT=$O(^DPT(BIDFN,"S",BIDT)) Q:'BIDT!(BIYES)  D
  1.  .N BIDATA,BIOI,X
  1.  .S BIDATA=$G(^DPT(BIDFN,"S",BIDT,0))
  1.  .Q:BIDATA=""
  1.  .;
  1.  .;---> Quit if appointment is cancelled.
  1.  .Q:$P(BIDATA,U,2)["C"
  1.  .;
  1.  .S X=0 F  S X=$O(^SC(+BIDATA,"S",BIDT,1,X)) Q:'X  D
  1.  ..Q:+$G(^SC(+BIDATA,"S",BIDT,1,X,0))'=BIDFN
  1.  ..S BIYES=BIDT_U_+BIDATA
  1.  ;
  1.  Q:'BIYES "None"
  1.  ;
  1.  S BIAPPT=$$FMTE^XLFDT(+BIYES,"1P")_" with "
  1.  S BIAPPT=BIAPPT_$P($G(^SC($P(BIYES,U,2),0)),U)
  1.  Q BIAPPT
  1.  ;
  1.  ;
  1.  ;----------
  1. LASTIMM(BIDFN,BICVXS,BIQDT,BIALL) ;PEP - Return latest date patient received CVX vaccine(s).
  1.  ;---> Return the latest Fileman date on which any one of the CVX's in the
  1.  ;---> string BICVXS was received.  Return 0 (zero) if none received.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) IEN of Patient in ^DPT.
  1.  ;     2 - BICVXS (req) String of CVX Codes to check, delimited by comma.
  1.  ;     3 - BIQDT  (opt) Quarter Ending Date (ignore Visits after this date).
  1.  ;     4 - BIALL  (opt) If BIALL=1 return string of dates (comma delim) before BIQDT.
  1.  ;     5 - BIVG   (opt) *NOT USED* Vaccine Group (if BIVG=IEN of Vaccine Group, check that way).
  1.  ;
  1.  Q:'$G(BIDFN) 0
  1.  Q:'$G(BICVXS) 0
  1.  N BICVX,BIDATE,I S BIDATE=0
  1.  ;
  1.  F I=1:1 S BICVX=$P(BICVXS,",",I) Q:BICVX=""  D
  1.  .S BIIEN=$$HL7TX^BIUTL2(BICVX)
  1.  .;---> Quit if CVX Code does not exist in Vaccine Table (or=OTHER).
  1.  .Q:('BIIEN!(BIIEN=137)) 0
  1.  .N N S N=0
  1.  .F  S N=$O(^AUPNVIMM("AC",BIDFN,N)) Q:'N  D
  1.  ..N X,Y S X=$G(^AUPNVIMM(N,0))
  1.  ..;---> Quit if this visit doesn't match the desired CVX Code.
  1.  ..Q:(+X'=BIIEN)
  1.  ..;
  1.  ..;---> Get pointer to Visit (to get date of visit).
  1.  ..S Y=$P(X,U,3)
  1.  ..Q:'Y
  1.  ..S Y=$P(+$G(^AUPNVSIT(Y,0)),".")
  1.  ..Q:'Y
  1.  ..;---> Quit if this Visit was after the Quarter Ending Date.
  1.  ..I $G(BIQDT) Q:(Y>BIQDT)
  1.  ..;
  1.  ..;---> If returning all dates, concat string and quit.
  1.  ..I $G(BIALL) D  Q
  1.  ...I BIDATE S BIDATE=BIDATE_","_Y Q
  1.  ...S BIDATE=Y
  1.  ..;
  1.  ..;---> If only returning last date, reset BIDATE if this is later than any prior BIDATE.
  1.  ..S:(Y>BIDATE) BIDATE=Y
  1.  ;
  1.  ;---> Return the latest Visit Date for this set of CVX Codes.
  1.  Q BIDATE
  1.  ;
  1.  ;
  1.  ;----------
  1. LASTCPT(BIDFN,BICPTS,BIQDT,BIALL) ;EP
  1.  ;---> Return the latest Fileman date on which any one of the CPT's in the
  1.  ;---> string BICPTS was received.  Return 0 (zero) if none received.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient DFN
  1.  ;     2 - BICPTS (req) String of CPT Codes to check, delimited by comma.
  1.  ;     3 - BIQDT  (opt) Quarter Ending Date (ignore Visits after this date).
  1.  ;     4 - BIALL  (opt) If BIALL=1 return string of dates (comma delim) before BIQDT.
  1.  ;
  1.  Q:'$G(BIDFN) 0
  1.  Q:'$G(BICPTS) 0
  1.  N BICPT,BIDATE,I S BIDATE=0
  1.  F I=1:1 S BICPT=$P(BICPTS,",",I) Q:BICPT=""  D
  1.  .N N S N=0
  1.  .F  S N=$O(^AUPNVCPT("AA",BIDFN,BICPT,N)) Q:'N  D
  1.  ..N BIDATE1 S BIDATE1=9999999-N
  1.  ..I $G(BIQDT) Q:(BIDATE1>BIQDT)
  1.  ..;
  1.  ..;---> If returning all dates, concat string and quit.
  1.  ..I $G(BIALL) D  Q
  1.  ...I BIDATE S BIDATE=BIDATE_","_BIDATE1 Q
  1.  ...S BIDATE=BIDATE1
  1.  ..;
  1.  ..;---> If only returning last date, reset BIDATE if this is later than any prior BIDATE.
  1.  ..S:(BIDATE1>BIDATE) BIDATE=BIDATE1
  1.  ;
  1.  ;---> Return the latest Visit Date for this set of CPT Codes.
  1.  Q BIDATE
  1.  ;
  1.  ;
  1.  ;----------
  1. MOTHMAID(DFN) ;EP
  1.  ;---> CodeChange for v7.1 - IHS/CMI/MWR 12/01/2000:
  1.  ;---> This is a new call added.
  1.  ;---> Return patient's mother's maiden name.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;
  1.  Q:'$G(DFN) "No DFN"
  1.  Q $P($G(^DPT(DFN,.24)),U,3)
  1.  ;
  1.  ;
  1.  ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
  1.  ;---> Call to limit export of imms to specific vaccines within a date range.
  1.  ;----------
  1. GOTDOSE(BIDFN,BIVIEN,BIRDT) ;EP
  1.  ;---> Return 1 if patient received one or more doses of the input vaccine
  1.  ;--->  within the givin date range; otherwise return 0.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - BIVIEN (req) IEN of Vaccine.
  1.  ;     3 - BIRDT  (opt) Date range in Fileman format YYYMMDD:YYYMMDD
  1.  ;
  1.  Q:'$G(BIDFN) 0
  1.  Q:'$G(BIVIEN) 0  Q:'$D(^AUTTIMM(BIVIEN,0)) 0
  1.  ;
  1.  N BISDT,BIEDT
  1.  S BISDT=+$P($G(BIRDT),":")
  1.  S BIEDT=+$P($G(BIRDT),":",2) I BIEDT=0 S BIEDT=9999999
  1.  ;
  1.  N N,Z S N=0,Z=0
  1.  F  S N=$O(^AUPNVIMM("AC",BIDFN,N)) Q:'N  Q:Z  D
  1.  .N X,Y S X=$G(^AUPNVIMM(N,0))
  1.  .;---> Quit if this visit doesn't match the desired vaccine.
  1.  .Q:(+X'=BIVIEN)
  1.  .;
  1.  .;---> Get pointer to Visit (to get date of visit).
  1.  .S Y=$P(X,U,3)
  1.  .Q:'Y
  1.  .S Y=$P(+$G(^AUPNVSIT(Y,0)),".")
  1.  .Q:'Y
  1.  .;---> Quit if this Visit was before the Start Date.
  1.  .Q:(Y<BISDT)
  1.  .;---> Quit if this Visit was after the End Date.
  1.  .Q:(Y>BIEDT)
  1.  .;---> Got a dose.
  1.  .S Z=1
  1.  ;
  1.  Q Z