BIVISIT ;IHS/CMI/MWR - ADD/EDIT IMM/SKIN VISITS.; MAY 10, 2010
;;8.5;IMMUNIZATION;**10**;MAY 30,2015
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; CODE TO ADD V IMMUNIZATION AND V SKIN TEST VISITS. CALLED BY BIRPC3.
;; PATCH 5: Added BINOM parameter to ADDEDIT P.E.P. for Visit Selection Menu. ADDV+0
;; Added Admin Note, piece 27. PARSE+36,+66, ADDV+16, VFILE+13,+184
;; PATCH 9: Added save of Admin Date and VIS Presented Date. VFILE+200
;; If >19yrs on date of immunization and Elig="", set Elig-V01. VFILE+188
;; PATCH 10: Added save of Skin Test Lot Number. VFILE+143
;
;
;----------
PARSE(Y,Z) ;EP
;---> Parse out passed Visit and V File data into local variables.
;---> Parameters:
; 1 - Y (req) String of data for the Visit to be added.
; 2 - Z (opt) If Z=1 do NOT set BIVSIT (call from VFILE below must
; preserve new Visit IEN sent to it).
;
;---> Pieces of Y delimited by "|":
; -----------------------------
; 1 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.
; 2 - BIDFN (req) DFN of patient.
; 3 - BIPTR (req) Vaccine or Skin Test .01 pointer.
; 4 - BIDOSE (opt) Dose# number for this Immunization.
; 5 - BILOT (opt) Lot Number IEN for this Immunization.
; 6 - BIDATE (req) Date.Time of Visit.
; 7 - BILOC (req) Location of encounter IEN.
; 8 - BIOLOC (opt) Other Location of encounter.
; 9 - BICAT (req) Category: A (Ambul), I (Inpat), E (Event/Hist)
; 10 - BIVSIT (opt) Visit IEN.
; 11 - BIOIEN (opt) Old V File IEN (for edits).
; 12 - BIRES (req) Skin Test Result: P,N,D,O.
; 13 - BIREA (req) Skin Test Reading: 0-40.
; 14 - BIDTR (req) Skin Test Date Read.
; 15 - BIREC (opt) Vaccine Reaction.
; 16 - BIVFC (opt) VFC Eligibility. vvv83
; 17 - BIVISD (opt) Release/Revision Date of VIS (YYYMMDD).
; 18 - BIPROV (opt) IEN of Provider of Immunization/Skin Test.
; 19 - BIOVRD (opt) Dose Override.
; 20 - BIINJS (opt) Injection Site.
; 21 - BIVOL (opt) Volume.
; 22 - BIREDR (opt) IEN of Reader of Skin Test.
; 23 - BISITE (opt) Passed DUZ(2) for Site Parameters.
; 24 - BICCPT (opt) If created from CPT ^DD BICCPT=1 or IEN; otherwise=""
; (called from BIRPC6
; 25 - BIMPRT (opt) If =1 it was imported.
; 26 - BINDC (opt) NDC Code IEN pointer to file #9002084.95.
; 27 - BIANOT (opt) Administrative Note (<161 chars).
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> Add Admin Date and VIS Presented Date to data being saved.
; 28 - BIADMIN (opt) Admin Date (Date shot admin'd to patient.
; 29 - BIVPRES (opt) Date VIS Presented to Patient.
;
;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
; 30 - BILOTSK (opt) Skin Test Lot Number.
;
N V S V="|"
;
S BIVTYPE=$P(Y,V,1)
S BIDFN=$P(Y,V,2)
S BIPTR=$P(Y,V,3)
S BIDOSE=$P(Y,V,4)
S BILOT=$P(Y,V,5)
S BIDATE=$P(Y,V,6) S:$P(BIDATE,".",2)="" BIDATE=BIDATE_".12"
S BILOC=$P(Y,V,7)
S BIOLOC=$P(Y,V,8)
S BICAT=$P(Y,V,9)
S:'$G(Z) BIVSIT=$P(Y,V,10)
S BIOIEN=$P(Y,V,11)
S BIRES=$P(Y,V,12)
S BIREA=$P(Y,V,13)
S BIDTR=$P(Y,V,14) S:BIDTR<1 BIDTR=""
S BIREC=$P(Y,V,15)
S BIVFC=$P(Y,V,16)
S BIVISD=$P(Y,V,17)
S BIPROV=$P(Y,V,18)
S BIOVRD=$P(Y,V,19)
S BIINJS=$P(Y,V,20)
S BIVOL=$P(Y,V,21)
S BIREDR=$P(Y,V,22)
S BISITE=$P(Y,V,23)
S BICCPT=$P(Y,V,24)
S BIMPRT=$P(Y,V,25)
S BINDC=$P(Y,V,26)
S BIANOT=$P(Y,V,27)
S BIADMIN=$P(Y,V,28)
S BIVPRES=$P(Y,V,29)
S BILOTSK=$P(Y,V,30)
;**********
Q
;
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added BINOM parameter to control Visit Menu display.
;----------
ADDV(BIERR,BIDATA,BIOIEN,BINOM) ;EP
;---> Add a Visit (if necessary) and V FILE entry for this patient.
;---> Called exclusively by ^BIRPC3.
;---> Parameters:
; 1 - BIERR (ret) 1^Text of Error Code if any, otherwise null.
; 2 - BIDATA (req) String of data for the Visit to be added.
; See BIDATA definition at linelabel PARSE (above).
; 3 - BIOIEN (opt) IEN of V IMM or V SKIN being edited (if
; not new).
; 4 - BINOM (opt) 0=Allow display of Visit Selection Menu if site
; parameter is set. 1=No display (for export).
;
I BIDATA="" D ERRCD^BIUTL2(437,.BIERR) S BIERR="1^"_BIERR Q
;
N BIVTYPE,BIDFN,BIPTR,BIDOSE,BILOT,BIDATE,BILOC,BIOLOC,BICAT,BIVSIT
N BIOIEN,BIRES,BIREA,BIDTR,BIREC,BIVISD,BIPROV,BIOVRD,BIINJS,BIVOL
N BIREDR,BISITE,BICCPT,BIMPRT,BIANOT,BILOTSK
;
;---> See BIDATA definition at linelabel PARSE.
D PARSE(BIDATA)
;
N APCDALVR,APCDANE,AUPNTALK,BITEST,DLAYGO,X
S BIERR=0
;
;---> Set BITEST=1 To display VISIT and V IMM pointers after sets.
;---> NOTE: This will write directly to IO. Should be turned OFF
;---> (BITEST=0) when not testing in M Programmer mode.
S BITEST=0
;
;---> If this is an edit, check or set BIVSIT=IEN of Parent Visit.
D:$G(BIOIEN)
.I (BIVTYPE'="I"&(BIVTYPE'="S")) D Q
..D ERRCD^BIUTL2(410,.BIERR) S BIERR="1^"_BIERR
.;
.;---> Quit if valid Visit IEN passed.
.Q:$G(^AUPNVSIT(+$G(BIVSIT),0))
.;
.;---> Get Visit IEN from V File entry (and set in BIDATA).
.N BIGBL S BIGBL=$S(BIVTYPE="I":"^AUPNVIMM(",1:"^AUPNVSK(")
.S BIGBL=BIGBL_BIOIEN_",0)"
.;---> Get IEN of VISIT.
.S BIVSIT=$P($G(@BIGBL),U,3)
Q:BIERR
;
;---> Create or edit Visit if necessary.
;---> NOTE: BIVSIT, even if sent, might come backed changed (due to
;---> change in Date, Category, etc.)
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added BINOM parameter to control Visit Menu display.
S:($G(BINOM)="") BINOM=0
D VISIT^BIVISIT1(BIDFN,BIDATE,BICAT,BILOC,BIOLOC,BISITE,.BIVSIT,.BIERR,BINOM)
;**********
Q:BIERR
;
;---> Create V FILE entry.
D VFILE($G(BIVSIT),BIDATA,.BIERR)
Q:BIERR
;
;---> If this was a mod to an existing Visit, update VISIT Field .13.
D:($G(BIOIEN)&($G(BIVSIT)))
.N AUPNVSIT,DA,DIE,DLAYGO
.S AUPNVSIT=BIVSIT,DLAYGO=9000010
.D MOD^AUPNVSIT
;
Q
;
;
;----------
VFILE(BIVSIT,BIDATA,BIERR) ;EP
;---> Add (create) V IMMUNIZATION or V SKIN TEST entry for this Visit.
;---> Parameters:
; 1 - BIVSIT (req) IEN of Parent Visit.
; 2 - BIDATA (req) String of data for the Visit to be added.
; See BIDATA definition at linelabel PARSE.
; 3 - BIERR (ret) Text of Error Code if any, otherwise null.
;
;
I BIDATA="" D ERRCD^BIUTL2(437,.BIERR) S BIERR="1^"_BIERR Q
;
N BIVTYPE,BIDFN,BIPTR,BIDOSE,BILOT,BIDATE,BILOC,BIOLOC,BICAT
N BIOIEN,BIRES,BIREA,BIDTR,BIREC,BIVISD,BIPROV,BIOVRD,BIINJS,BIVOL
N BIREDR,BISITE,BICCPT,BIMPRT,BIANOT,BILOTSK
;
;---> See BIDATA definition at linelabel PARSE (above).
D PARSE(BIDATA,1)
;
;---> Fields in V IMMUNIZATION File are as follows:
;
; .01 APCDTIMM Pointer to IMMUNIZATION File (Vaccine)
; .02 APCDPAT Patient
; .03 APCDVSIT IEN of Visit
; .04 APCDTSER Dose# (Series#)
; .05 APCDTLOT Lot# IEN, Pointer to IMMUNIZATION LOT File
; .06 APCDTREC Reaction
;
; This will no longer be used:
; .07 APCDTCON Contraindication (Stored in ^BIP.)
;
; .12 APCDTVSD VIS Date (Lori will put in a future template.)
; 1204 APCDTEPR Immunization Provider
;
;---> Fields in V SKIN TEST File are as follows:
;
; .01 APCDTSK Pointer to IMMUNIZATION File
; .02 APCDPAT Patient
; .03 APCDVSIT IEN of Visit
; .04 APCDTRES Result
; .05 APCDTREA Reading
; .06 APCDTDR Date read
; 1204 APCDTEPR Skin Test Provider
;
;---> Check that a Parent VISIT exists.
I '$D(^AUPNVSIT(+$G(BIVSIT),0)) D Q
.D ERRCD^BIUTL2(432,.BIERR) S BIERR="1^"_BIERR
;
N APCDALVR
;
;---> Set Visit pointer.
S APCDALVR("APCDVSIT")=BIVSIT
;
;---> Set Patient.
S APCDALVR("APCDPAT")=BIDFN
;
;
;
;---> * * * If this is an IMMUNIZATION, set APCD array for Immunizations. * * *
;
I BIVTYPE="I" D
.;
.;---> Set permission override for this file.
.S DLAYGO=9000010.11
.;
.;---> Immunization/vaccine name.
.S APCDALVR("APCDTIMM")="`"_BIPTR
.;
.;---> Dose# for this immunization.
.;S:'$G(BIDOSE) BIDOSE=""
.;S APCDALVR("APCDTSER")=BIDOSE
.;
.;---> Lot Number IEN for this immunization.
.S:'$G(BILOT) BILOT=""
.;---> Lot Number passed to PCC more reliably if prepend "`".
.;---> Imm v8.5: Handle Lot Number below
.;S:BILOT BILOT="`"_BILOT
.;S APCDALVR("APCDTLOT")=BILOT
.;
.;---> Reaction to this vaccine on this Visit.
.S:'$G(BIREC) BIREC=""
.S APCDALVR("APCDTREC")=BIREC
.;
.;---> Immunization Provider ("Shot giver").
.S:$G(BIPROV) APCDALVR("APCDTEPR")="`"_BIPROV
.;
.;---> User who last edited this Immunization.
.S:$G(DUZ) APCDALVR("APCDTULU")="`"_DUZ
.;
.;---> Template to add encounter to V IMMUNIZATION File.
.S APCDALVR("APCDATMP")="[APCDALVR 9000010.11 (ADD)]"
;
;
;
;---> * * * If this is a SKIN TEST, set APCD array for Skin Tests. * * *
;
I BIVTYPE="S" D
.;
.;---> Set permission override for this file.
.S DLAYGO=9000010.12
.;
.;---> Skin Test name.
.S APCDALVR("APCDTSK")="`"_BIPTR
.;
.;---> Skin Test Result.
.S APCDALVR("APCDTRES")=BIRES
.;
.;---> Skin Test Reading (mm).
.S APCDALVR("APCDTREA")=BIREA
.;
.;---> Skin Test Date Read.
.S APCDALVR("APCDTDR")=BIDTR
.;
.;---> Skin Test Provider (Person who administered the test).
.S:$G(BIPROV) APCDALVR("APCDTEPR")="`"_BIPROV
.;
.;---> Template to add encounter to V SKIN TEST File.
.S APCDALVR("APCDATMP")="[APCDALVR 9000010.12 (ADD)]"
;
;
;---> * * * CALL TO APCDALVR. * * *
D EN^APCDALVR
D:$G(BITEST) DISPLAY2^BIPCC
;
;---> Quit if a V File entry was not created.
I '$G(APCDALVR("APCDADFN"))!($D(APCDALVR("APCDAFLG"))) D Q
.I BIVTYPE="I" D ERRCD^BIUTL2(402,.BIERR) S BIERR="1^"_BIERR Q
.I BIVTYPE="S" D ERRCD^BIUTL2(413,.BIERR) S BIERR="1^"_BIERR
;
;Returns: APCDADFN - IEN of V IMMUNIZATION File entry.
; APCDAFLG - =2 If FAILED to create a V FILE entry.
;
;
;---> Save IEN of V IMMUNIZATION just created.
N BIADFN S BIADFN=APCDALVR("APCDADFN")
;
;
;---> ADD OTHER V SKIN TEST FIELDS:
;---> If this is a Skin Test, add Skin Test Reader and Quit.
I BIVTYPE="S" D Q
.;---> Store Additional data.
.N BIFLD
.S BIFLD(.08)=BIREDR,BIFLD(.09)=BIINJS,BIFLD(.11)=BIVOL
.;
.;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI
.;---> BILOTSK (opt) Skin Test Lot Number.
.S BIFLD(.14)=BILOTSK
.;
.;---> Set DATE/TIME LAST MODIFIED, per Lori Butcher, 5/26/12
.S:$G(BIOIEN) BIFLD(1218)=$$NOW^XLFDT
.;
.D FDIE^BIFMAN(9000010.12,BIADFN,.BIFLD,.BIERR)
.I BIERR=1 D ERRCD^BIUTL2(421,.BIERR) S BIERR="1^"_BIERR
.;
.;---> If Skin Test is a PPD and result is Positive, add Contraindication
.;---> to further TST-PPD tests.
.I $$SKNAME^BIUTL6($G(BIPTR))="PPD",$E($G(BIRES))="P" D
..;---> Set date equal to either Date Read, or Date of Visit, or Today.
..N BIDTC S BIDTC=$S($G(BIDTR):BIDTR,$G(BIDATE):$P(BIDATE,"."),1:$G(DT))
..S BIDATA=BIDFN_"|"_203_"|"_17_"|"_BIDTC
..D ADDCONT^BIRPC4(,BIDATA)
;
;
;---> ADD OTHER V IMMUNIZATION FIELDS:
;---> Quit if this is not an Immunization.
Q:BIVTYPE'="I"
;
;---> Add VIS, Dose Override, Injection Site and Volume data.
;---> Build DR string.
;
S:(BIVISD<1) BIVISD="@" S:BIOVRD="" BIOVRD="@"
;
S:BIINJS="" BIINJS="@" S:BIVOL="" BIVOL="@"
S:BILOT="" BIILOT="@" S:BINDC="" BINDC="@"
;
;---> Store Additional data.
N BIFLD
S BIFLD(.05)=BILOT
S BIFLD(.08)=BIOVRD,BIFLD(.09)=BIINJS
S BIFLD(.11)=BIVOL,BIFLD(.12)=BIVISD,BIFLD(.13)=BICCPT
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> If patient is 19yrs or older at the time of the immunization,
;---> and Eligibility is null, set Eligibility=V01.
D
.Q:(BIVFC]"")
.N BIAGDT S BIAGDT=$S($G(BIADMIN):BIADMIN,1:BIDATE)
.I $$AGE^BIUTL1(BIDFN,1,BIAGDT)>18 S BIVFC=$O(^BIELIG("B","V01",0))
;**********
;
S BIFLD(.14)=BIVFC
S BIFLD(.15)=$S(BIMPRT>0:2,1:"")
S BIFLD(.16)=BINDC
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added Admin Note, piece 27.
S:($G(BIANOT)]"") BIFLD(1)=BIANOT
;**********
;
;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
;---> Set DATE/TIME LAST MODIFIED, per Lori Butcher, 5/26/12
S:$G(BIOIEN) BIFLD(1218)=$$NOW^XLFDT
;**********
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> Add Admin Date and VIS Presented Date to data being saved.
; 28 - BIADMIN Admin Date (Date shot admin'd to patient.
; 29 - BIVPRES Date VIS Presented to Patient.
;
S BIFLD(1201)=BIADMIN
S BIFLD(.17)=BIVPRES
;**********
;
D FDIE^BIFMAN(9000010.11,BIADFN,.BIFLD,.BIERR)
I BIERR=1 D Q
.D ERRCD^BIUTL2(421,.BIERR) S BIERR="1^"_BIERR
;
;
;---> If there was an anaphylactic reaction to this vaccine,
;---> add it as a contraindication for this patient.
D:BIREC=9
.Q:'$G(BIDFN) Q:'$G(BIPTR) Q:'$G(BIDATE)
.N BIREAS S BIREAS=$O(^BICONT("B","Anaphylaxis",0))
.Q:'BIREAS
.;
.N BIADD,N,V S N=0,BIADD=1,V="|"
.;---> Loop through patient's existing contraindications.
.F S N=$O(^BIPC("B",BIDFN,N)) Q:'N Q:'BIADD D
..N X S X=$G(^BIPC(N,0))
..Q:'X
..;---> Quit (BIADD=0) if this contra/reason/date already exists.
..I $P(X,U,2)=BIPTR&($P(X,U,3)=BIREAS)&($P(X,U,4)=BIDATE) S BIADD=0
.Q:'BIADD
.;
.D ADDCONT^BIRPC4(.BIERR,BIDFN_V_BIPTR_V_BIREAS_V_BIDATE)
.I $G(BIERR)]"" S BIERR="1^"_BIERR
;
;---> Now trigger New Immunization Trigger Event.
D TRIGADD
Q
;
;
;----------
TRIGADD ;EP
;---> Immunization Added Trigger Event call to Protocol File.
D TRIGADD^BIVISIT2
Q
;
;
;----------
VFILE1 ;EP
;---> Add (create) V IMMUNIZATION from ^DD of V CPT.
;---> Called from EN^XBNEW, from CPTIMM^BIRPC6
;---> Local Variables:
; 1 - BIVSIT (req) IEN of Parent Visit.
; 2 - BIDATA (req) String of data for the Visit to be added.
; See BIDATA definition at linelabel PARSE.
;
Q:'$G(BIVSIT) Q:'$D(BIDATA)
D VFILE(BIVSIT,BIDATA)
Q
;
;
;----------
IMPORT(APCDALVR) ;PEP - Code to flag V Imm as "Imported."
;---> Code for Tom Love to flag entry as Imported From Outside Registry.
;---> Parameters:
; 1 - APCDALVR (req) Array returned from call to EN^APCDALVR.
; APCDALVR("APCDADFN") - IEN of V IMMUNIZATION File entry.
; APCDALVR("APCDAFLG") - =2 If FAILED to create a V FILE entry.
;
Q:($G(APCDALVR("APCDAFLG")))
Q:('$G(APCDALVR("APCDADFN")))
N BIADFN S BIADFN=APCDALVR("APCDADFN")
;
;---> Add Import From Outside.
N BIFLD S BIFLD(.15)=1
D FDIE^BIFMAN(9000010.11,BIADFN,.BIFLD,.BIERR)
Q
BIVISIT ;IHS/CMI/MWR - ADD/EDIT IMM/SKIN VISITS.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**10**;MAY 30,2015
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; CODE TO ADD V IMMUNIZATION AND V SKIN TEST VISITS. CALLED BY BIRPC3.
+4 ;; PATCH 5: Added BINOM parameter to ADDEDIT P.E.P. for Visit Selection Menu. ADDV+0
+5 ;; Added Admin Note, piece 27. PARSE+36,+66, ADDV+16, VFILE+13,+184
+6 ;; PATCH 9: Added save of Admin Date and VIS Presented Date. VFILE+200
+7 ;; If >19yrs on date of immunization and Elig="", set Elig-V01. VFILE+188
+8 ;; PATCH 10: Added save of Skin Test Lot Number. VFILE+143
+9 ;
+10 ;
+11 ;----------
PARSE(Y,Z) ;EP
+1 ;---> Parse out passed Visit and V File data into local variables.
+2 ;---> Parameters:
+3 ; 1 - Y (req) String of data for the Visit to be added.
+4 ; 2 - Z (opt) If Z=1 do NOT set BIVSIT (call from VFILE below must
+5 ; preserve new Visit IEN sent to it).
+6 ;
+7 ;---> Pieces of Y delimited by "|":
+8 ; -----------------------------
+9 ; 1 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.
+10 ; 2 - BIDFN (req) DFN of patient.
+11 ; 3 - BIPTR (req) Vaccine or Skin Test .01 pointer.
+12 ; 4 - BIDOSE (opt) Dose# number for this Immunization.
+13 ; 5 - BILOT (opt) Lot Number IEN for this Immunization.
+14 ; 6 - BIDATE (req) Date.Time of Visit.
+15 ; 7 - BILOC (req) Location of encounter IEN.
+16 ; 8 - BIOLOC (opt) Other Location of encounter.
+17 ; 9 - BICAT (req) Category: A (Ambul), I (Inpat), E (Event/Hist)
+18 ; 10 - BIVSIT (opt) Visit IEN.
+19 ; 11 - BIOIEN (opt) Old V File IEN (for edits).
+20 ; 12 - BIRES (req) Skin Test Result: P,N,D,O.
+21 ; 13 - BIREA (req) Skin Test Reading: 0-40.
+22 ; 14 - BIDTR (req) Skin Test Date Read.
+23 ; 15 - BIREC (opt) Vaccine Reaction.
+24 ; 16 - BIVFC (opt) VFC Eligibility. vvv83
+25 ; 17 - BIVISD (opt) Release/Revision Date of VIS (YYYMMDD).
+26 ; 18 - BIPROV (opt) IEN of Provider of Immunization/Skin Test.
+27 ; 19 - BIOVRD (opt) Dose Override.
+28 ; 20 - BIINJS (opt) Injection Site.
+29 ; 21 - BIVOL (opt) Volume.
+30 ; 22 - BIREDR (opt) IEN of Reader of Skin Test.
+31 ; 23 - BISITE (opt) Passed DUZ(2) for Site Parameters.
+32 ; 24 - BICCPT (opt) If created from CPT ^DD BICCPT=1 or IEN; otherwise=""
+33 ; (called from BIRPC6
+34 ; 25 - BIMPRT (opt) If =1 it was imported.
+35 ; 26 - BINDC (opt) NDC Code IEN pointer to file #9002084.95.
+36 ; 27 - BIANOT (opt) Administrative Note (<161 chars).
+37 ;
+38 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+39 ;---> Add Admin Date and VIS Presented Date to data being saved.
+40 ; 28 - BIADMIN (opt) Admin Date (Date shot admin'd to patient.
+41 ; 29 - BIVPRES (opt) Date VIS Presented to Patient.
+42 ;
+43 ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
+44 ; 30 - BILOTSK (opt) Skin Test Lot Number.
+45 ;
+46 NEW V
SET V="|"
+47 ;
+48 SET BIVTYPE=$PIECE(Y,V,1)
+49 SET BIDFN=$PIECE(Y,V,2)
+50 SET BIPTR=$PIECE(Y,V,3)
+51 SET BIDOSE=$PIECE(Y,V,4)
+52 SET BILOT=$PIECE(Y,V,5)
+53 SET BIDATE=$PIECE(Y,V,6)
IF $PIECE(BIDATE,".",2)=""
SET BIDATE=BIDATE_".12"
+54 SET BILOC=$PIECE(Y,V,7)
+55 SET BIOLOC=$PIECE(Y,V,8)
+56 SET BICAT=$PIECE(Y,V,9)
+57 IF '$GET(Z)
SET BIVSIT=$PIECE(Y,V,10)
+58 SET BIOIEN=$PIECE(Y,V,11)
+59 SET BIRES=$PIECE(Y,V,12)
+60 SET BIREA=$PIECE(Y,V,13)
+61 SET BIDTR=$PIECE(Y,V,14)
IF BIDTR<1
SET BIDTR=""
+62 SET BIREC=$PIECE(Y,V,15)
+63 SET BIVFC=$PIECE(Y,V,16)
+64 SET BIVISD=$PIECE(Y,V,17)
+65 SET BIPROV=$PIECE(Y,V,18)
+66 SET BIOVRD=$PIECE(Y,V,19)
+67 SET BIINJS=$PIECE(Y,V,20)
+68 SET BIVOL=$PIECE(Y,V,21)
+69 SET BIREDR=$PIECE(Y,V,22)
+70 SET BISITE=$PIECE(Y,V,23)
+71 SET BICCPT=$PIECE(Y,V,24)
+72 SET BIMPRT=$PIECE(Y,V,25)
+73 SET BINDC=$PIECE(Y,V,26)
+74 SET BIANOT=$PIECE(Y,V,27)
+75 SET BIADMIN=$PIECE(Y,V,28)
+76 SET BIVPRES=$PIECE(Y,V,29)
+77 SET BILOTSK=$PIECE(Y,V,30)
+78 ;**********
+79 QUIT
+80 ;
+81 ;
+82 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+83 ;---> Added BINOM parameter to control Visit Menu display.
+84 ;----------
ADDV(BIERR,BIDATA,BIOIEN,BINOM) ;EP
+1 ;---> Add a Visit (if necessary) and V FILE entry for this patient.
+2 ;---> Called exclusively by ^BIRPC3.
+3 ;---> Parameters:
+4 ; 1 - BIERR (ret) 1^Text of Error Code if any, otherwise null.
+5 ; 2 - BIDATA (req) String of data for the Visit to be added.
+6 ; See BIDATA definition at linelabel PARSE (above).
+7 ; 3 - BIOIEN (opt) IEN of V IMM or V SKIN being edited (if
+8 ; not new).
+9 ; 4 - BINOM (opt) 0=Allow display of Visit Selection Menu if site
+10 ; parameter is set. 1=No display (for export).
+11 ;
+12 IF BIDATA=""
DO ERRCD^BIUTL2(437,.BIERR)
SET BIERR="1^"_BIERR
QUIT
+13 ;
+14 NEW BIVTYPE,BIDFN,BIPTR,BIDOSE,BILOT,BIDATE,BILOC,BIOLOC,BICAT,BIVSIT
+15 NEW BIOIEN,BIRES,BIREA,BIDTR,BIREC,BIVISD,BIPROV,BIOVRD,BIINJS,BIVOL
+16 NEW BIREDR,BISITE,BICCPT,BIMPRT,BIANOT,BILOTSK
+17 ;
+18 ;---> See BIDATA definition at linelabel PARSE.
+19 DO PARSE(BIDATA)
+20 ;
+21 NEW APCDALVR,APCDANE,AUPNTALK,BITEST,DLAYGO,X
+22 SET BIERR=0
+23 ;
+24 ;---> Set BITEST=1 To display VISIT and V IMM pointers after sets.
+25 ;---> NOTE: This will write directly to IO. Should be turned OFF
+26 ;---> (BITEST=0) when not testing in M Programmer mode.
+27 SET BITEST=0
+28 ;
+29 ;---> If this is an edit, check or set BIVSIT=IEN of Parent Visit.
+30 IF $GET(BIOIEN)
Begin DoDot:1
+31 IF (BIVTYPE'="I"&(BIVTYPE'="S"))
Begin DoDot:2
+32 DO ERRCD^BIUTL2(410,.BIERR)
SET BIERR="1^"_BIERR
End DoDot:2
QUIT
+33 ;
+34 ;---> Quit if valid Visit IEN passed.
+35 IF $GET(^AUPNVSIT(+$GET(BIVSIT),0))
QUIT
+36 ;
+37 ;---> Get Visit IEN from V File entry (and set in BIDATA).
+38 NEW BIGBL
SET BIGBL=$SELECT(BIVTYPE="I":"^AUPNVIMM(",1:"^AUPNVSK(")
+39 SET BIGBL=BIGBL_BIOIEN_",0)"
+40 ;---> Get IEN of VISIT.
+41 SET BIVSIT=$PIECE($GET(@BIGBL),U,3)
End DoDot:1
+42 IF BIERR
QUIT
+43 ;
+44 ;---> Create or edit Visit if necessary.
+45 ;---> NOTE: BIVSIT, even if sent, might come backed changed (due to
+46 ;---> change in Date, Category, etc.)
+47 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+48 ;---> Added BINOM parameter to control Visit Menu display.
+49 IF ($GET(BINOM)="")
SET BINOM=0
+50 DO VISIT^BIVISIT1(BIDFN,BIDATE,BICAT,BILOC,BIOLOC,BISITE,.BIVSIT,.BIERR,BINOM)
+51 ;**********
+52 IF BIERR
QUIT
+53 ;
+54 ;---> Create V FILE entry.
+55 DO VFILE($GET(BIVSIT),BIDATA,.BIERR)
+56 IF BIERR
QUIT
+57 ;
+58 ;---> If this was a mod to an existing Visit, update VISIT Field .13.
+59 IF ($GET(BIOIEN)&($GET(BIVSIT)))
Begin DoDot:1
+60 NEW AUPNVSIT,DA,DIE,DLAYGO
+61 SET AUPNVSIT=BIVSIT
SET DLAYGO=9000010
+62 DO MOD^AUPNVSIT
End DoDot:1
+63 ;
+64 QUIT
+65 ;
+66 ;
+67 ;----------
VFILE(BIVSIT,BIDATA,BIERR) ;EP
+1 ;---> Add (create) V IMMUNIZATION or V SKIN TEST entry for this Visit.
+2 ;---> Parameters:
+3 ; 1 - BIVSIT (req) IEN of Parent Visit.
+4 ; 2 - BIDATA (req) String of data for the Visit to be added.
+5 ; See BIDATA definition at linelabel PARSE.
+6 ; 3 - BIERR (ret) Text of Error Code if any, otherwise null.
+7 ;
+8 ;
+9 IF BIDATA=""
DO ERRCD^BIUTL2(437,.BIERR)
SET BIERR="1^"_BIERR
QUIT
+10 ;
+11 NEW BIVTYPE,BIDFN,BIPTR,BIDOSE,BILOT,BIDATE,BILOC,BIOLOC,BICAT
+12 NEW BIOIEN,BIRES,BIREA,BIDTR,BIREC,BIVISD,BIPROV,BIOVRD,BIINJS,BIVOL
+13 NEW BIREDR,BISITE,BICCPT,BIMPRT,BIANOT,BILOTSK
+14 ;
+15 ;---> See BIDATA definition at linelabel PARSE (above).
+16 DO PARSE(BIDATA,1)
+17 ;
+18 ;---> Fields in V IMMUNIZATION File are as follows:
+19 ;
+20 ; .01 APCDTIMM Pointer to IMMUNIZATION File (Vaccine)
+21 ; .02 APCDPAT Patient
+22 ; .03 APCDVSIT IEN of Visit
+23 ; .04 APCDTSER Dose# (Series#)
+24 ; .05 APCDTLOT Lot# IEN, Pointer to IMMUNIZATION LOT File
+25 ; .06 APCDTREC Reaction
+26 ;
+27 ; This will no longer be used:
+28 ; .07 APCDTCON Contraindication (Stored in ^BIP.)
+29 ;
+30 ; .12 APCDTVSD VIS Date (Lori will put in a future template.)
+31 ; 1204 APCDTEPR Immunization Provider
+32 ;
+33 ;---> Fields in V SKIN TEST File are as follows:
+34 ;
+35 ; .01 APCDTSK Pointer to IMMUNIZATION File
+36 ; .02 APCDPAT Patient
+37 ; .03 APCDVSIT IEN of Visit
+38 ; .04 APCDTRES Result
+39 ; .05 APCDTREA Reading
+40 ; .06 APCDTDR Date read
+41 ; 1204 APCDTEPR Skin Test Provider
+42 ;
+43 ;---> Check that a Parent VISIT exists.
+44 IF '$DATA(^AUPNVSIT(+$GET(BIVSIT),0))
Begin DoDot:1
+45 DO ERRCD^BIUTL2(432,.BIERR)
SET BIERR="1^"_BIERR
End DoDot:1
QUIT
+46 ;
+47 NEW APCDALVR
+48 ;
+49 ;---> Set Visit pointer.
+50 SET APCDALVR("APCDVSIT")=BIVSIT
+51 ;
+52 ;---> Set Patient.
+53 SET APCDALVR("APCDPAT")=BIDFN
+54 ;
+55 ;
+56 ;
+57 ;---> * * * If this is an IMMUNIZATION, set APCD array for Immunizations. * * *
+58 ;
+59 IF BIVTYPE="I"
Begin DoDot:1
+60 ;
+61 ;---> Set permission override for this file.
+62 SET DLAYGO=9000010.11
+63 ;
+64 ;---> Immunization/vaccine name.
+65 SET APCDALVR("APCDTIMM")="`"_BIPTR
+66 ;
+67 ;---> Dose# for this immunization.
+68 ;S:'$G(BIDOSE) BIDOSE=""
+69 ;S APCDALVR("APCDTSER")=BIDOSE
+70 ;
+71 ;---> Lot Number IEN for this immunization.
+72 IF '$GET(BILOT)
SET BILOT=""
+73 ;---> Lot Number passed to PCC more reliably if prepend "`".
+74 ;---> Imm v8.5: Handle Lot Number below
+75 ;S:BILOT BILOT="`"_BILOT
+76 ;S APCDALVR("APCDTLOT")=BILOT
+77 ;
+78 ;---> Reaction to this vaccine on this Visit.
+79 IF '$GET(BIREC)
SET BIREC=""
+80 SET APCDALVR("APCDTREC")=BIREC
+81 ;
+82 ;---> Immunization Provider ("Shot giver").
+83 IF $GET(BIPROV)
SET APCDALVR("APCDTEPR")="`"_BIPROV
+84 ;
+85 ;---> User who last edited this Immunization.
+86 IF $GET(DUZ)
SET APCDALVR("APCDTULU")="`"_DUZ
+87 ;
+88 ;---> Template to add encounter to V IMMUNIZATION File.
+89 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.11 (ADD)]"
End DoDot:1
+90 ;
+91 ;
+92 ;
+93 ;---> * * * If this is a SKIN TEST, set APCD array for Skin Tests. * * *
+94 ;
+95 IF BIVTYPE="S"
Begin DoDot:1
+96 ;
+97 ;---> Set permission override for this file.
+98 SET DLAYGO=9000010.12
+99 ;
+100 ;---> Skin Test name.
+101 SET APCDALVR("APCDTSK")="`"_BIPTR
+102 ;
+103 ;---> Skin Test Result.
+104 SET APCDALVR("APCDTRES")=BIRES
+105 ;
+106 ;---> Skin Test Reading (mm).
+107 SET APCDALVR("APCDTREA")=BIREA
+108 ;
+109 ;---> Skin Test Date Read.
+110 SET APCDALVR("APCDTDR")=BIDTR
+111 ;
+112 ;---> Skin Test Provider (Person who administered the test).
+113 IF $GET(BIPROV)
SET APCDALVR("APCDTEPR")="`"_BIPROV
+114 ;
+115 ;---> Template to add encounter to V SKIN TEST File.
+116 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.12 (ADD)]"
End DoDot:1
+117 ;
+118 ;
+119 ;---> * * * CALL TO APCDALVR. * * *
+120 DO EN^APCDALVR
+121 IF $GET(BITEST)
DO DISPLAY2^BIPCC
+122 ;
+123 ;---> Quit if a V File entry was not created.
+124 IF '$GET(APCDALVR("APCDADFN"))!($DATA(APCDALVR("APCDAFLG")))
Begin DoDot:1
+125 IF BIVTYPE="I"
DO ERRCD^BIUTL2(402,.BIERR)
SET BIERR="1^"_BIERR
QUIT
+126 IF BIVTYPE="S"
DO ERRCD^BIUTL2(413,.BIERR)
SET BIERR="1^"_BIERR
End DoDot:1
QUIT
+127 ;
+128 ;Returns: APCDADFN - IEN of V IMMUNIZATION File entry.
+129 ; APCDAFLG - =2 If FAILED to create a V FILE entry.
+130 ;
+131 ;
+132 ;---> Save IEN of V IMMUNIZATION just created.
+133 NEW BIADFN
SET BIADFN=APCDALVR("APCDADFN")
+134 ;
+135 ;
+136 ;---> ADD OTHER V SKIN TEST FIELDS:
+137 ;---> If this is a Skin Test, add Skin Test Reader and Quit.
+138 IF BIVTYPE="S"
Begin DoDot:1
+139 ;---> Store Additional data.
+140 NEW BIFLD
+141 SET BIFLD(.08)=BIREDR
SET BIFLD(.09)=BIINJS
SET BIFLD(.11)=BIVOL
+142 ;
+143 ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI
+144 ;---> BILOTSK (opt) Skin Test Lot Number.
+145 SET BIFLD(.14)=BILOTSK
+146 ;
+147 ;---> Set DATE/TIME LAST MODIFIED, per Lori Butcher, 5/26/12
+148 IF $GET(BIOIEN)
SET BIFLD(1218)=$$NOW^XLFDT
+149 ;
+150 DO FDIE^BIFMAN(9000010.12,BIADFN,.BIFLD,.BIERR)
+151 IF BIERR=1
DO ERRCD^BIUTL2(421,.BIERR)
SET BIERR="1^"_BIERR
+152 ;
+153 ;---> If Skin Test is a PPD and result is Positive, add Contraindication
+154 ;---> to further TST-PPD tests.
+155 IF $$SKNAME^BIUTL6($GET(BIPTR))="PPD"
IF $EXTRACT($GET(BIRES))="P"
Begin DoDot:2
+156 ;---> Set date equal to either Date Read, or Date of Visit, or Today.
+157 NEW BIDTC
SET BIDTC=$SELECT($GET(BIDTR):BIDTR,$GET(BIDATE):$PIECE(BIDATE,"."),1:$GET(DT))
+158 SET BIDATA=BIDFN_"|"_203_"|"_17_"|"_BIDTC
+159 DO ADDCONT^BIRPC4(,BIDATA)
End DoDot:2
End DoDot:1
QUIT
+160 ;
+161 ;
+162 ;---> ADD OTHER V IMMUNIZATION FIELDS:
+163 ;---> Quit if this is not an Immunization.
+164 IF BIVTYPE'="I"
QUIT
+165 ;
+166 ;---> Add VIS, Dose Override, Injection Site and Volume data.
+167 ;---> Build DR string.
+168 ;
+169 IF (BIVISD<1)
SET BIVISD="@"
IF BIOVRD=""
SET BIOVRD="@"
+170 ;
+171 IF BIINJS=""
SET BIINJS="@"
IF BIVOL=""
SET BIVOL="@"
+172 IF BILOT=""
SET BIILOT="@"
IF BINDC=""
SET BINDC="@"
+173 ;
+174 ;---> Store Additional data.
+175 NEW BIFLD
+176 SET BIFLD(.05)=BILOT
+177 SET BIFLD(.08)=BIOVRD
SET BIFLD(.09)=BIINJS
+178 SET BIFLD(.11)=BIVOL
SET BIFLD(.12)=BIVISD
SET BIFLD(.13)=BICCPT
+179 ;
+180 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+181 ;---> If patient is 19yrs or older at the time of the immunization,
+182 ;---> and Eligibility is null, set Eligibility=V01.
+183 Begin DoDot:1
+184 IF (BIVFC]"")
QUIT
+185 NEW BIAGDT
SET BIAGDT=$SELECT($GET(BIADMIN):BIADMIN,1:BIDATE)
+186 IF $$AGE^BIUTL1(BIDFN,1,BIAGDT)>18
SET BIVFC=$ORDER(^BIELIG("B","V01",0))
End DoDot:1
+187 ;**********
+188 ;
+189 SET BIFLD(.14)=BIVFC
+190 SET BIFLD(.15)=$SELECT(BIMPRT>0:2,1:"")
+191 SET BIFLD(.16)=BINDC
+192 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+193 ;---> Added Admin Note, piece 27.
+194 IF ($GET(BIANOT)]"")
SET BIFLD(1)=BIANOT
+195 ;**********
+196 ;
+197 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+198 ;---> Set DATE/TIME LAST MODIFIED, per Lori Butcher, 5/26/12
+199 IF $GET(BIOIEN)
SET BIFLD(1218)=$$NOW^XLFDT
+200 ;**********
+201 ;
+202 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+203 ;---> Add Admin Date and VIS Presented Date to data being saved.
+204 ; 28 - BIADMIN Admin Date (Date shot admin'd to patient.
+205 ; 29 - BIVPRES Date VIS Presented to Patient.
+206 ;
+207 SET BIFLD(1201)=BIADMIN
+208 SET BIFLD(.17)=BIVPRES
+209 ;**********
+210 ;
+211 DO FDIE^BIFMAN(9000010.11,BIADFN,.BIFLD,.BIERR)
+212 IF BIERR=1
Begin DoDot:1
+213 DO ERRCD^BIUTL2(421,.BIERR)
SET BIERR="1^"_BIERR
End DoDot:1
QUIT
+214 ;
+215 ;
+216 ;---> If there was an anaphylactic reaction to this vaccine,
+217 ;---> add it as a contraindication for this patient.
+218 IF BIREC=9
Begin DoDot:1
+219 IF '$GET(BIDFN)
QUIT
IF '$GET(BIPTR)
QUIT
IF '$GET(BIDATE)
QUIT
+220 NEW BIREAS
SET BIREAS=$ORDER(^BICONT("B","Anaphylaxis",0))
+221 IF 'BIREAS
QUIT
+222 ;
+223 NEW BIADD,N,V
SET N=0
SET BIADD=1
SET V="|"
+224 ;---> Loop through patient's existing contraindications.
+225 FOR
SET N=$ORDER(^BIPC("B",BIDFN,N))
IF 'N
QUIT
IF 'BIADD
QUIT
Begin DoDot:2
+226 NEW X
SET X=$GET(^BIPC(N,0))
+227 IF 'X
QUIT
+228 ;---> Quit (BIADD=0) if this contra/reason/date already exists.
+229 IF $PIECE(X,U,2)=BIPTR&($PIECE(X,U,3)=BIREAS)&($PIECE(X,U,4)=BIDATE)
SET BIADD=0
End DoDot:2
+230 IF 'BIADD
QUIT
+231 ;
+232 DO ADDCONT^BIRPC4(.BIERR,BIDFN_V_BIPTR_V_BIREAS_V_BIDATE)
+233 IF $GET(BIERR)]""
SET BIERR="1^"_BIERR
End DoDot:1
+234 ;
+235 ;---> Now trigger New Immunization Trigger Event.
+236 DO TRIGADD
+237 QUIT
+238 ;
+239 ;
+240 ;----------
TRIGADD ;EP
+1 ;---> Immunization Added Trigger Event call to Protocol File.
+2 DO TRIGADD^BIVISIT2
+3 QUIT
+4 ;
+5 ;
+6 ;----------
VFILE1 ;EP
+1 ;---> Add (create) V IMMUNIZATION from ^DD of V CPT.
+2 ;---> Called from EN^XBNEW, from CPTIMM^BIRPC6
+3 ;---> Local Variables:
+4 ; 1 - BIVSIT (req) IEN of Parent Visit.
+5 ; 2 - BIDATA (req) String of data for the Visit to be added.
+6 ; See BIDATA definition at linelabel PARSE.
+7 ;
+8 IF '$GET(BIVSIT)
QUIT
IF '$DATA(BIDATA)
QUIT
+9 DO VFILE(BIVSIT,BIDATA)
+10 QUIT
+11 ;
+12 ;
+13 ;----------
IMPORT(APCDALVR) ;PEP - Code to flag V Imm as "Imported."
+1 ;---> Code for Tom Love to flag entry as Imported From Outside Registry.
+2 ;---> Parameters:
+3 ; 1 - APCDALVR (req) Array returned from call to EN^APCDALVR.
+4 ; APCDALVR("APCDADFN") - IEN of V IMMUNIZATION File entry.
+5 ; APCDALVR("APCDAFLG") - =2 If FAILED to create a V FILE entry.
+6 ;
+7 IF ($GET(APCDALVR("APCDAFLG")))
QUIT
+8 IF ('$GET(APCDALVR("APCDADFN")))
QUIT
+9 NEW BIADFN
SET BIADFN=APCDALVR("APCDADFN")
+10 ;
+11 ;---> Add Import From Outside.
+12 NEW BIFLD
SET BIFLD(.15)=1
+13 DO FDIE^BIFMAN(9000010.11,BIADFN,.BIFLD,.BIERR)
+14 QUIT
