BIVISIT2 ;IHS/CMI/MWR - DELETE VISITS; MAY 10, 2010
;;8.5;IMMUNIZATION;**5**;JUL 01,2013
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; CODE TO DELETE V FILE VISITS, TRIGGER EVENT FOR DELETE IMM.
;; PATCH 5: TRIGADD EP moved from rtn BIVISIT for Rsize. TRIGADD+0
;
;
;----------
DELETE(BIDA,BIVTYPE,BIERR) ;EP
;---> Delete a V IMMUNIZATION File entry.
;---> Called exclusively by ^BIRPC3.
;---> Parameters:
; 1 - BIDA (req) IEN of V File entry to be deleted.
; 2 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.
; 3 - BIERR (ret) Text of Error Code if any, otherwise null.
;
;---> If DA not passed, set Error Code and quit.
I '$G(BIDA) D ERRCD^BIUTL2(404,.BIERR) Q
;
;---> If BIVTYPE does not="I" (Immunization Visit) and it does
;---> not="S" (Skin Test Visit), then set Error Code and quit.
I ($G(BIVTYPE)'="I")&($G(BIVTYPE)'="S") D Q
.D ERRCD^BIUTL2(410,.BIERR)
;
;---> DIK kills D.
N BIGBL,BIGBLK
S BIGBLK=$S(BIVTYPE="I":"^AUPNVIMM(",1:"^AUPNVSK(")
S BIGBL=BIGBLK_BIDA_",0)"
;
;---> If V File Visit doesn't exist, set Error and quit.
I '$D(@BIGBL) D ERRCD^BIUTL2(411,.BIERR) Q
;
;---> Save VISIT pointer for this V File entry.
N APCDVDLT S APCDVDLT=$P(@BIGBL,U,3)
;
;---> Store Immunization Visit data for Trigger Event in BIDATA.
N BIDATA
D:BIVTYPE="I" SAVEDATA(BIDA,.BIDATA)
;
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Switch to logical deletion of V Immunizations.
;---> Note: Edits are also stored and can be reviewed.
;
D:BIVTYPE="I"
.N BINODE S BINODE=@BIGBL
.;---> Create an entry in BI PATIENT CONTRAINDICATION DELETED File.
.N BIERR,BIIEN,BIFLD
.S BIFLD(.01)=$P(BINODE,U,1)
.S BIFLD(.02)=$P(BINODE,U,2)
.S BIFLD(.03)=$P(BINODE,U,3)
.S BIFLD(2.01)=+$G(DUZ)
.D NOW^%DTC S BIFLD(2.02)=%
.D UPDATE^BIFMAN(9002084.118,.BIIEN,.BIFLD,.BIERR)
.;---> Quit if new entry failed.
.I BIERR]"" S BIERR=BI31_BIERR Q
.;---> Quit if new entry IEN bad.
.I '$D(^BIVIMMD(+BIIEN(1),0)) D Q
..D ERRCD^BIUTL2(450,.BIERR) S BIERR=BI31_BIERR
.;---> Now copy the rest of the Imm data.
.S ^BIVIMMD(+BIIEN(1),0)=^AUPNVIMM(BIDA,0)
.S:($D(^AUPNVIMM(BIDA,1))) ^BIVIMMD(+BIIEN(1),1)=^AUPNVIMM(BIDA,1)
.S:($D(^AUPNVIMM(BIDA,12))) ^BIVIMMD(+BIIEN(1),12)=^AUPNVIMM(BIDA,12)
;
Q:(BIERR]"")
;**********
;
;---> Delete the V File entry (and decrement the
;---> Dependent Entry Count of the parent Visit).
N D,DA,DIK S DA=BIDA,DIK=BIGBLK
D ^DIK
;
;---> If deletion of the V File Visit failed, set Error and quit.
I $D(@BIGBL) D ERRCD^BIUTL2(428,.BIERR) Q
;
;---> If the DEPENDENT ENTRY COUNT for parent Visit is 0, then
;---> delete the Visit, too.
S DLAYGO=9000010
D:'$P(^AUPNVSIT(APCDVDLT,0),U,9) ^APCDVDLT
;
;---> Trigger Event, call Protocol: BI DELETE IMMUNIZATION.
D:BIVTYPE="I" TRIGDEL($G(BIDATA))
;
Q
;
;
;----------
SAVEDATA(BIDA,BIDATA) ;EP
;---> Save V Immunization data for Trigger Event, return in BIDATA.
;---> Parameters:
; 1 - BIDA (req) IEN of V IMMUNIZATION entry.
; 2 - BIDATA (ret) String of data returned.
;
Q:'$G(BIDA)
;
;---> Specify Data Elements to collect.
;
;---> IEN PC DATA
;---> --- -- ----
;---> 4 2 = Vaccine Name, Short.
;---> 6 3 = Dose#.
;---> 25 4 = Vaccine Code, HL7.
;---> 30 5 = Vaccine IEN.
;---> 33 6 = Vaccine Lot Number (text).
;---> 34 7 = Location IEN.
;---> 35 8 = Category of Visit (A,E, or I)
;---> 36 9 = Location Other (text).
;---> 44 10 = Vaccine Reaction (text).
;---> 56 11 = Date of Immunization (Fileman format).
;---> 58 12 = Patient DFN.
;---> 59 13 = Visit, PCC Type (I,C,6).
;
N BIDE,I
F I=4,6,25,30,33,34,35,36,44,56,58,59 S BIDE(I)=""
D GET^BIRPC1(.BIDATA,BIDA,"I",.BIDE)
;
;---> If an error is passed back, set BIDATA="".
N BI31 S BI31=$C(31)_$C(31)
I $P(BIDATA,BI31,2)]"" S BIDATA="" Q
S BIDATA=$P(BIDATA,BI31)
Q
;
;
;----------
TRIGDEL(BIDATA) ;EP
;---> Immunization Deleted Trigger Event call to Protocol File.
;---> V Immunization data of just deleted visit is saved in BIDATA.
;---> (Note: Trigger Event for ADD Immunization is in rtn BIVISIT.)
;---> Parameters:
; 1 - BIDATA (req) String of V Imm data.
;
Q:$G(BIDATA)=""
;
;---> Local variables available when Delete Event is triggered:
;
; BICAT - Category: A (Ambul), I (Inpat), E (Event/Hist)
; BIDATE - Date of Visit (Fileman format).
; BIDFN - DFN of patient.
; BIDOSE - Dose# number for this Immunization.
; BILOC - Location of encounter (IEN).
; BILOT - Lot number for this Immunization (text).
; BIOLOC - Other Location of encounter (text).
; BIPTR - Vaccine (IEN in IMMUNIZATION File).
; BIREC - Vaccine Reaction (text).
; BITYPE - Type of Visit (PCC Master Control File I,C,6).
; BIVHL7 - Vaccine HL7 Code.
; BIVISD - Release/Revision Date of VIS (YYYMMDD).
; BIVNAM - Vaccine Name, short form.
;
;---> Parse out Immunization Visit data in local variables.
N V S V="|"
;
S BICAT=$P(BIDATA,V,8)
S BIDATE=$P(BIDATA,V,11)
S BIDFN=$P(BIDATA,V,12)
S BIDOSE=$P(BIDATA,V,3)
S BILOC=$P(BIDATA,V,7)
S BILOT=$P(BIDATA,V,6)
S BIOLOC=$P(BIDATA,V,9)
S BIPTR=$P(BIDATA,V,5)
S BIREC=$P(BIDATA,V,10)
S BITYPE=$P(BIDATA,V,13)
S BIVHL7=$P(BIDATA,V,4)
S BIVNAM=$P(BIDATA,V,2)
;
;---> Local variables available when Event is triggered:
;---> Exclusive New of all variables except those to be available.
N BISAVE
S BISAVE="BICAT;BIDATE;BIDFN;BIDOSE;BILOC;BILOT;BIOLOC;BIPTR"
S BISAVE=BISAVE_";BIREC;BITYPE;BIVHL7;BIVNAM;DIC;X;XQORS"
;
D
.S DIC=101,X="BI IMMUNIZATION DELETED"
.D EN^XBNEW("EN^XQOR",BISAVE)
;
Q
;
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> TRIGADD EP moved from rtn BIVISIT for Rsize.
;----------
TRIGADD ;EP
;---> Exclusively called from VFILE+216^BIVISIT.
;---> Immunization Added Trigger Event call to Protocol File.
;---> Called at the end/bottom of BIVISIT, after new V IMM created.
;---> (Note: Trigger Event for DELETE Immunization is in rtn BIVISIT2.)
;---> Local variables available when Event is triggered:
;
; BIADFN - IEN of V IMMUNIZATION just created.
; BICAT - Category: A (Ambul), I (Inpat), E (Event/Hist)
; BIDATE - Date of Visit (Fileman format).
; BIDFN - DFN of patient.
; BILOC - Location of encounter (IEN).
; BILOT - Lot Number IEN for this Immunization (text).
; BIOLOC - Other Location of encounter (text).
; BIPTR - Vaccine (IEN in IMMUNIZATION File).
; BIREC - Vaccine Reaction (text).
; BITYPE - Type of Visit (PCC Master Control File I,C,6).
; BIVHL7 - Vaccine HL7 Code.
; BIVNAM - Vaccine Name, short form.
; BIVSIT - IEN of Visit.
;
;
N BIVNAM,BIVHL7,BISAVE
S BIVNAM=$$VNAME^BIUTL2(BIPTR)
S BIVHL7=$$CODE^BIUTL2(BIPTR,1)
S BIREC=$$REACTXT^BIUTL6(BIREC)
S BILOT=$$LOTTX^BIUTL6(BILOT)
;
S BISAVE="BIADFN;BICAT;BIDATE;BIDFN;BILOC;BILOT;BIOLOC;BIPTR"
S BISAVE=BISAVE_";BIREC;BITYPE;BIVHL7;BIVNAM;BIVSIT;DIC;X;XQORS"
D
.S DIC=101,X="BI IMMUNIZATION ADDED"
.D EN^XBNEW("EN^XQOR",BISAVE)
;
Q
;**********
BIVISIT2 ;IHS/CMI/MWR - DELETE VISITS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**5**;JUL 01,2013
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; CODE TO DELETE V FILE VISITS, TRIGGER EVENT FOR DELETE IMM.
+4 ;; PATCH 5: TRIGADD EP moved from rtn BIVISIT for Rsize. TRIGADD+0
+5 ;
+6 ;
+7 ;----------
DELETE(BIDA,BIVTYPE,BIERR) ;EP
+1 ;---> Delete a V IMMUNIZATION File entry.
+2 ;---> Called exclusively by ^BIRPC3.
+3 ;---> Parameters:
+4 ; 1 - BIDA (req) IEN of V File entry to be deleted.
+5 ; 2 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.
+6 ; 3 - BIERR (ret) Text of Error Code if any, otherwise null.
+7 ;
+8 ;---> If DA not passed, set Error Code and quit.
+9 IF '$GET(BIDA)
DO ERRCD^BIUTL2(404,.BIERR)
QUIT
+10 ;
+11 ;---> If BIVTYPE does not="I" (Immunization Visit) and it does
+12 ;---> not="S" (Skin Test Visit), then set Error Code and quit.
+13 IF ($GET(BIVTYPE)'="I")&($GET(BIVTYPE)'="S")
Begin DoDot:1
+14 DO ERRCD^BIUTL2(410,.BIERR)
End DoDot:1
QUIT
+15 ;
+16 ;---> DIK kills D.
+17 NEW BIGBL,BIGBLK
+18 SET BIGBLK=$SELECT(BIVTYPE="I":"^AUPNVIMM(",1:"^AUPNVSK(")
+19 SET BIGBL=BIGBLK_BIDA_",0)"
+20 ;
+21 ;---> If V File Visit doesn't exist, set Error and quit.
+22 IF '$DATA(@BIGBL)
DO ERRCD^BIUTL2(411,.BIERR)
QUIT
+23 ;
+24 ;---> Save VISIT pointer for this V File entry.
+25 NEW APCDVDLT
SET APCDVDLT=$PIECE(@BIGBL,U,3)
+26 ;
+27 ;---> Store Immunization Visit data for Trigger Event in BIDATA.
+28 NEW BIDATA
+29 IF BIVTYPE="I"
DO SAVEDATA(BIDA,.BIDATA)
+30 ;
+31 ;
+32 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+33 ;---> Switch to logical deletion of V Immunizations.
+34 ;---> Note: Edits are also stored and can be reviewed.
+35 ;
+36 IF BIVTYPE="I"
Begin DoDot:1
+37 NEW BINODE
SET BINODE=@BIGBL
+38 ;---> Create an entry in BI PATIENT CONTRAINDICATION DELETED File.
+39 NEW BIERR,BIIEN,BIFLD
+40 SET BIFLD(.01)=$PIECE(BINODE,U,1)
+41 SET BIFLD(.02)=$PIECE(BINODE,U,2)
+42 SET BIFLD(.03)=$PIECE(BINODE,U,3)
+43 SET BIFLD(2.01)=+$GET(DUZ)
+44 DO NOW^%DTC
SET BIFLD(2.02)=%
+45 DO UPDATE^BIFMAN(9002084.118,.BIIEN,.BIFLD,.BIERR)
+46 ;---> Quit if new entry failed.
+47 IF BIERR]""
SET BIERR=BI31_BIERR
QUIT
+48 ;---> Quit if new entry IEN bad.
+49 IF '$DATA(^BIVIMMD(+BIIEN(1),0))
Begin DoDot:2
+50 DO ERRCD^BIUTL2(450,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:2
QUIT
+51 ;---> Now copy the rest of the Imm data.
+52 SET ^BIVIMMD(+BIIEN(1),0)=^AUPNVIMM(BIDA,0)
+53 IF ($DATA(^AUPNVIMM(BIDA,1)))
SET ^BIVIMMD(+BIIEN(1),1)=^AUPNVIMM(BIDA,1)
+54 IF ($DATA(^AUPNVIMM(BIDA,12)))
SET ^BIVIMMD(+BIIEN(1),12)=^AUPNVIMM(BIDA,12)
End DoDot:1
+55 ;
+56 IF (BIERR]"")
QUIT
+57 ;**********
+58 ;
+59 ;---> Delete the V File entry (and decrement the
+60 ;---> Dependent Entry Count of the parent Visit).
+61 NEW D,DA,DIK
SET DA=BIDA
SET DIK=BIGBLK
+62 DO ^DIK
+63 ;
+64 ;---> If deletion of the V File Visit failed, set Error and quit.
+65 IF $DATA(@BIGBL)
DO ERRCD^BIUTL2(428,.BIERR)
QUIT
+66 ;
+67 ;---> If the DEPENDENT ENTRY COUNT for parent Visit is 0, then
+68 ;---> delete the Visit, too.
+69 SET DLAYGO=9000010
+70 IF '$PIECE(^AUPNVSIT(APCDVDLT,0),U,9)
DO ^APCDVDLT
+71 ;
+72 ;---> Trigger Event, call Protocol: BI DELETE IMMUNIZATION.
+73 IF BIVTYPE="I"
DO TRIGDEL($GET(BIDATA))
+74 ;
+75 QUIT
+76 ;
+77 ;
+78 ;----------
SAVEDATA(BIDA,BIDATA) ;EP
+1 ;---> Save V Immunization data for Trigger Event, return in BIDATA.
+2 ;---> Parameters:
+3 ; 1 - BIDA (req) IEN of V IMMUNIZATION entry.
+4 ; 2 - BIDATA (ret) String of data returned.
+5 ;
+6 IF '$GET(BIDA)
QUIT
+7 ;
+8 ;---> Specify Data Elements to collect.
+9 ;
+10 ;---> IEN PC DATA
+11 ;---> --- -- ----
+12 ;---> 4 2 = Vaccine Name, Short.
+13 ;---> 6 3 = Dose#.
+14 ;---> 25 4 = Vaccine Code, HL7.
+15 ;---> 30 5 = Vaccine IEN.
+16 ;---> 33 6 = Vaccine Lot Number (text).
+17 ;---> 34 7 = Location IEN.
+18 ;---> 35 8 = Category of Visit (A,E, or I)
+19 ;---> 36 9 = Location Other (text).
+20 ;---> 44 10 = Vaccine Reaction (text).
+21 ;---> 56 11 = Date of Immunization (Fileman format).
+22 ;---> 58 12 = Patient DFN.
+23 ;---> 59 13 = Visit, PCC Type (I,C,6).
+24 ;
+25 NEW BIDE,I
+26 FOR I=4,6,25,30,33,34,35,36,44,56,58,59
SET BIDE(I)=""
+27 DO GET^BIRPC1(.BIDATA,BIDA,"I",.BIDE)
+28 ;
+29 ;---> If an error is passed back, set BIDATA="".
+30 NEW BI31
SET BI31=$CHAR(31)_$CHAR(31)
+31 IF $PIECE(BIDATA,BI31,2)]""
SET BIDATA=""
QUIT
+32 SET BIDATA=$PIECE(BIDATA,BI31)
+33 QUIT
+34 ;
+35 ;
+36 ;----------
TRIGDEL(BIDATA) ;EP
+1 ;---> Immunization Deleted Trigger Event call to Protocol File.
+2 ;---> V Immunization data of just deleted visit is saved in BIDATA.
+3 ;---> (Note: Trigger Event for ADD Immunization is in rtn BIVISIT.)
+4 ;---> Parameters:
+5 ; 1 - BIDATA (req) String of V Imm data.
+6 ;
+7 IF $GET(BIDATA)=""
QUIT
+8 ;
+9 ;---> Local variables available when Delete Event is triggered:
+10 ;
+11 ; BICAT - Category: A (Ambul), I (Inpat), E (Event/Hist)
+12 ; BIDATE - Date of Visit (Fileman format).
+13 ; BIDFN - DFN of patient.
+14 ; BIDOSE - Dose# number for this Immunization.
+15 ; BILOC - Location of encounter (IEN).
+16 ; BILOT - Lot number for this Immunization (text).
+17 ; BIOLOC - Other Location of encounter (text).
+18 ; BIPTR - Vaccine (IEN in IMMUNIZATION File).
+19 ; BIREC - Vaccine Reaction (text).
+20 ; BITYPE - Type of Visit (PCC Master Control File I,C,6).
+21 ; BIVHL7 - Vaccine HL7 Code.
+22 ; BIVISD - Release/Revision Date of VIS (YYYMMDD).
+23 ; BIVNAM - Vaccine Name, short form.
+24 ;
+25 ;---> Parse out Immunization Visit data in local variables.
+26 NEW V
SET V="|"
+27 ;
+28 SET BICAT=$PIECE(BIDATA,V,8)
+29 SET BIDATE=$PIECE(BIDATA,V,11)
+30 SET BIDFN=$PIECE(BIDATA,V,12)
+31 SET BIDOSE=$PIECE(BIDATA,V,3)
+32 SET BILOC=$PIECE(BIDATA,V,7)
+33 SET BILOT=$PIECE(BIDATA,V,6)
+34 SET BIOLOC=$PIECE(BIDATA,V,9)
+35 SET BIPTR=$PIECE(BIDATA,V,5)
+36 SET BIREC=$PIECE(BIDATA,V,10)
+37 SET BITYPE=$PIECE(BIDATA,V,13)
+38 SET BIVHL7=$PIECE(BIDATA,V,4)
+39 SET BIVNAM=$PIECE(BIDATA,V,2)
+40 ;
+41 ;---> Local variables available when Event is triggered:
+42 ;---> Exclusive New of all variables except those to be available.
+43 NEW BISAVE
+44 SET BISAVE="BICAT;BIDATE;BIDFN;BIDOSE;BILOC;BILOT;BIOLOC;BIPTR"
+45 SET BISAVE=BISAVE_";BIREC;BITYPE;BIVHL7;BIVNAM;DIC;X;XQORS"
+46 ;
+47 Begin DoDot:1
+48 SET DIC=101
SET X="BI IMMUNIZATION DELETED"
+49 DO EN^XBNEW("EN^XQOR",BISAVE)
End DoDot:1
+50 ;
+51 QUIT
+52 ;
+53 ;
+54 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+55 ;---> TRIGADD EP moved from rtn BIVISIT for Rsize.
+56 ;----------
TRIGADD ;EP
+1 ;---> Exclusively called from VFILE+216^BIVISIT.
+2 ;---> Immunization Added Trigger Event call to Protocol File.
+3 ;---> Called at the end/bottom of BIVISIT, after new V IMM created.
+4 ;---> (Note: Trigger Event for DELETE Immunization is in rtn BIVISIT2.)
+5 ;---> Local variables available when Event is triggered:
+6 ;
+7 ; BIADFN - IEN of V IMMUNIZATION just created.
+8 ; BICAT - Category: A (Ambul), I (Inpat), E (Event/Hist)
+9 ; BIDATE - Date of Visit (Fileman format).
+10 ; BIDFN - DFN of patient.
+11 ; BILOC - Location of encounter (IEN).
+12 ; BILOT - Lot Number IEN for this Immunization (text).
+13 ; BIOLOC - Other Location of encounter (text).
+14 ; BIPTR - Vaccine (IEN in IMMUNIZATION File).
+15 ; BIREC - Vaccine Reaction (text).
+16 ; BITYPE - Type of Visit (PCC Master Control File I,C,6).
+17 ; BIVHL7 - Vaccine HL7 Code.
+18 ; BIVNAM - Vaccine Name, short form.
+19 ; BIVSIT - IEN of Visit.
+20 ;
+21 ;
+22 NEW BIVNAM,BIVHL7,BISAVE
+23 SET BIVNAM=$$VNAME^BIUTL2(BIPTR)
+24 SET BIVHL7=$$CODE^BIUTL2(BIPTR,1)
+25 SET BIREC=$$REACTXT^BIUTL6(BIREC)
+26 SET BILOT=$$LOTTX^BIUTL6(BILOT)
+27 ;
+28 SET BISAVE="BIADFN;BICAT;BIDATE;BIDFN;BILOC;BILOT;BIOLOC;BIPTR"
+29 SET BISAVE=BISAVE_";BIREC;BITYPE;BIVHL7;BIVNAM;BIVSIT;DIC;X;XQORS"
+30 Begin DoDot:1
+31 SET DIC=101
SET X="BI IMMUNIZATION ADDED"
+32 DO EN^XBNEW("EN^XQOR",BISAVE)
End DoDot:1
+33 ;
+34 QUIT
+35 ;**********
