BIPATVW2 ;IHS/CMI/MWR - ADD/EDIT/DELETE VISITS; MAY 10, 2010
;;8.5;IMMUNIZATION;**10**;MAY 30,2015
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;;BIB PROTOTYPE; JAN 31,2015
;; ADD, EDIT, DELETE VISITS VIA LIST MANAGER.
;; PATCH 1: Do not stuff default VFC if patient < 19 yrs. ADDIMM+33
;; PATCH 9: Add Admin Date and VIS Presented Date to array. EDITIMM+87
;; If patient is adult, set Eligibility default="V01". ADDIMM+40
;; PATCH 10: Add Skin Test Lot Number. EDITIMM+113
;
;
;----------
ADDIMM ;EP
;---> Add an Immunization via List Manager.
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI IMMUNIZATION VISIT ADD, an action on the
; List Manager menu protocol: BI MENU PATIENT VIEW
;
; 2) This code calls ScreenMan form:
; BI FORM-IMM VISIT ADD/EDIT to build BI local array
; of data for add/edit of Immunization visit.
; Data already stored in the BI local array is loaded
; into the form by LOADVIS^BIUTL7, which is called
; by the Pre-Action of Blocks for Imm/Skin Edits.
;
; 3) SAVISIT^BIUTL7 uses BI local array to build data
; to pass to ADDEDIT^BIRPC3 (which is also called by
; the Broker from the GUI).
;
; 4) BIRPC3 calls ADDV^BIVISIT, which adds the
; Visit to the V Files.
;
;---> Variables:
; 1 - BIDFN (req) Patient DFN.
; 2 - BIDUZ2 (req) DUZ(2) of User (for Site Parameters).
; 3 - BIDEFDT (opt) Default date of new Visit.
;
;---> Check that DFN for this patient is present.
I '$G(BIDFN) D ERRCD^BIUTL2(405,,1) D RESET Q
;
;
;********** BARCODE PROTO, v8.5, JAN 31,2015, IHS/CMI/MWR
;---> Parse parameter of scanned values for adding new Lot Numbers.
;N BI S BI("A")=BIDFN
I '$G(BISCANA) N BI
S BI("A")=BIDFN
;**********
;
;---> Set default VFC Eligibility.
;---> If Patient Ben Type is 01 (Am Indian/AK Native), set VFC default=4.
;
;********** PATCH 1, v8.3.1, Dec 30,2008, IHS/CMI/MWR
;---> Do NOT stuff VFC default if patient is not < 19 years old.
;I $$BENTYP^BIUTL11(BIDFN,2)="01" S BI("P")=4
;--> If patient was less than 19yrs set default=V01 and quit.
;Q:($$AGE^BIUTL1(BIDFN,1,BIDATE)>18)
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> If patient is adult, set Eligibility default="V01".
D
.I $$AGE^BIUTL1(BIDFN,1)<19,$$BENTYP^BIUTL11(BIDFN,2)="01" S BI("P")=4 Q
.;---> Otherwise patient is adult, set default="V01" and quit.
.S BI("P")=1
;**********
;
;---> Set default date.
S BI("E")=$G(BIDEFDT)
;
;---> Get Site IEN for parameters.
S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
I '$G(BIDUZ2) D ERRCD^BIUTL2(105,,1) Q
S BI("Z")=BIDUZ2
;
;---> Call Screenman to build BI local array of data by user.
;---> NOTE: The absence of BI("K") (IEN of Old V File entry) signals
;---> a NEW V Immunizaton.
;---> BISAVE=Flag to call BIUTL7 to save data (below). vvv83
;---> BITOLONG=Flag used in Screenman to display pop-up: Other Loc too long.
N BISAVE,BITOLONG
N DR S DR="[BI FORM-IMM VISIT ADD/EDIT]"
D DDS^BIFMAN(9000001,DR,BIDFN,"S",.BISAVE,.BIPOP)
;
;---> If user saved data, call ^BIUTL7 to save it.
D:$G(BISAVE) SAVISIT^BIUTL7("I",.BI)
;
D RESET
Q
;
;
;----------
ADDSK ;EP
;---> Add a Skin Test via List Manager.
;---> Steps are the same as ADDIMM above.
;
;---> Check that DFN for this patient is present.
I '$G(BIDFN) D ERRCD^BIUTL2(405,,1) D RESET Q
N BI S BI("A")=BIDFN
;
;---> Set default date and volume.
S BI("E")=$G(BIDEFDT),BI("W")=.1
;
;---> Get Site IEN for parameters.
S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
I '$G(BIDUZ2) D ERRCD^BIUTL2(105,,1) Q
S BI("Z")=BIDUZ2
;
;---> Call Screenman to build BI local array of data by user.
;---> NOTE: The absence of BI("K") (IEN of Old V File entry) signals
;---> a NEW V Skin Test.
;---> BISAVE=Flag to call BIUTL7 to save data (below). vvv83
;---> BITOLONG=Flag used in Screenman to display pop-up: Other Loc too long.
N BISAVE,BITOLONG
N DR S DR="[BI FORM-SKIN VISIT ADD/EDIT]"
D DDS^BIFMAN(9000001,DR,BIDFN,"S",.BISAVE,.BIPOP)
;
;---> If user saved data, call ^BIUTL7 to save it.
D:$G(BISAVE) SAVISIT^BIUTL7("S",.BI)
;
D RESET
Q
;
;
;----------
EDITIMM ;EP
;---> Edit an Immunization via List Manager.
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI V FILE VISIT EDIT, an action on the
; List Manager menu protocol: BI MENU PATIENT VIEW
;
; 2) This code gets an Imm Visit from List Manager
; and loads the data into the Screenman form:
; BI FORM-IMM VISIT ADD/EDIT to build BI local array
; of data for add/edit of Immunization visit.
; Data already stored in the BI local array is loaded
; into the form by LOADVIS^BIUTL7, which is called
; by the Pre-Action of Blocks for Imm/Skin Edits.
;
; 3) SAVISIT^BIUTL7 uses BI local array to build data
; to pass to ADDEDIT^BIRPC3 (which is also called by
; the Broker from the GUI).
;
; 4) BIRPC3 calls DELETE^BIVISIT and ADDV^BIVISIT,
; which broker Visits to the V Files.
;
;
;---> Call the List Manager Generic Selector of items displayed.
N VALMY
D EN^VALM2(XQORNOD(0),"OS")
;
;---> Check that Imm History string for this patient is present.
;---> If Imm History not supplied, set Error Code and quit.
I '$G(BIDFN) D ERRCD^BIUTL2(405,,1) D RESET Q
I $G(BIHX(BIDFN))']"" D ERRCD^BIUTL2(303,,1) D RESET Q
;
;---> Check that a Listman Item was passed; if so, set Y=which
;---> item (Imm Visit) was passed/selected.
;I '$D(VALMY) D ERRCD^BIUTL2(406,,1) D RESET Q
I '$D(VALMY) D RESET Q
N Y S Y=$O(VALMY(0))
I '$G(Y) D ERRCD^BIUTL2(406,,1) D RESET Q
;
;---> Get V Type: Imm or Skin.
N BIVTYPE S BIVTYPE=$P($P(BIHX(BIDFN),U,Y),"|")
;
;---> 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,,1) D RESET
;
;---> Set BIVFIEN=V File IEN.
N BIVFIEN S BIVFIEN=$P($P(BIHX(BIDFN),U,Y),"|",4)
;
;---> Gather data for this Visit to load for Screenman edit.
D GET^BIRPC1(.Y,BIVFIEN,BIVTYPE)
;
;---> If an error is passed back, display it and quit.
N BI31,BIERR S BI31=$C(31)_$C(31)
S BIERR=$P(Y,BI31,2)
I BIERR]"" D IO^BIO(BIERR),DIRZ^BIUTL3() D RESET Q
;
;---> If no error, then set Y=data (1st BI31 piece).
S Y=$P(Y,BI31)
;
;---> Build BI array of Visit data for ScreenMan Edit form.
N BI,DR,V S V="|"
;
;---> Build array for Immunization Visit.
D:BIVTYPE="I"
.S BI("A")=+BIDFN ;Patient DFN.
.S BI("B")=+$P(Y,V,7) ;Vaccine Name IEN.
.S BI("C")=$P(Y,V,3) ;Dose# of Immunization.
.S BI("D")=$P(Y,V,9) ;Lot Number IEN.
.S BI("E")=$P(Y,V,6) ;Date/Time of Imm Visit (ext form).
.S BI("F")=+$P(Y,V,11) ;Location of Encounter IEN.
.S BI("G")=$P(Y,V,13) ;Other Location of Encounter Text.
.S BI("I")=$P(Y,V,12) ;Catgegory of Visit (A,E,I).
.S BI("J")=$P(Y,V,22) ;Visit IEN.
.S BI("K")=BIVFIEN ;Old V File IEN - indicates EDIT of previous Imm.
.S BI("O")=+$P(Y,V,15) ;Reaction to Immunization on this Visit.
.S BI("P")=$P(Y,V,23) ;VFC Eligibility. vvv83
.S BI("Q")=$P(Y,V,17) ;Release/Revision Date of VIS (DD-Mmm-YYYY).
.S BI("R")=$P(Y,V,18) ;Immunization Provider.
.S BI("S")=$P(Y,V,19) ;Dose Override.
.S BI("T")=$P(Y,V,20) ;Injection Site.
.S BI("W")=$P(Y,V,21) ;Volume.
.S BI("Y")=$P(Y,V,24) ;Imported From Outside Source (=1).
.S BI("H")=$P(Y,V,25) ;NDC Code pointer IEN.
.;
.;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
.;---> Add VIS Presented Dateand Admin Date to array for Screenman.
.S BI("QQ")=$P(Y,V,30) ;Date VIS Presented to Patient.
.S BI("EE")=$P(Y,V,31) ;Admin/shot Date ONLY (not Visit); can be null.
.;**********
.;X ^O
.;
.S DR="[BI FORM-IMM VISIT ADD/EDIT]"
;
;---> Build array for Skin Test Visit.
D:BIVTYPE="S"
.S BI("A")=+BIDFN ;Patient DFN.
.S BI("B")=+$P(Y,V,13) ;Skin Test IEN.
.S BI("E")=$P(Y,V,4) ;Date/Time of Skin Test Visit (ext form).
.S BI("F")=+$P(Y,V,5) ;Location of Encounter IEN.
.S BI("G")=$P(Y,V,7) ;Other Location of Encounter Text.
.S BI("I")=$P(Y,V,6) ;Catgegory of Visit (A,E,I).
.S BI("J")=$P(Y,V,18) ;Visit IEN.
.S BI("K")=BIVFIEN ;Old V File IEN (for edits).
.S BI("L")=$P(Y,V,9) ;Skin Test Result.
.S BI("M")=$P(Y,V,10) ;Skin Test Reading.
.S BI("N")=$P(Y,V,11) ;Skin Test Date Read.
.S BI("R")=$P(Y,V,14) ;Skin Test Provider.
.S BI("T")=$P(Y,V,15) ;Injection Site.
.S BI("W")=$P(Y,V,16) ;Volume.
.S BI("X")=$P(Y,V,17) ;Skin Test Reader.
.;
.;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
.;---> Add Skin Test Lot Number.
.S BI("LL")=$P(Y,V,19)
.;**********
.S DR="[BI FORM-SKIN VISIT ADD/EDIT]"
;
;
;---> Get Site IEN for parameters.
S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
I '$G(BIDUZ2) D ERRCD^BIUTL2(105,,1) Q
S BI("Z")=BIDUZ2
;
;---> Call Screenman to build BI local array of data edited by user.
;---> BISAVE=Flag to call BIUTL7 to save data (below). vvv83
;---> BITOLONG=Flag used in Screenman to display pop-up: Other Loc too long.
N BISAVE,BITOLONG
D DDS^BIFMAN(9000001,DR,BIDFN,"S",.BISAVE,.BIPOP)
;
;---> If user saved data, call ^BIUTL7 to save it.
D:$G(BISAVE) SAVISIT^BIUTL7(BIVTYPE,.BI)
;
D RESET
Q
;
;
;----------
DELETIMM ;EP
;---> Delete an Immunization or Skin Test via List Manager.
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI V FILE VISIT DELETE, an action on the
; List Manager menu protocol: BI MENU PATIENT VIEW
;
; 2) This code gets an Imm or Skin Visit from List Manager
; and calls DELETE^BIRPC3 (which is also called by
; the Broker from the GUI).
;
; 5) BIRPC3 calls DELETE^BIVISIT, which will
; delete the V File entry.
;
;---> Call the List Manager Generic Selector of items displayed.
N VALMY
D EN^VALM2(XQORNOD(0),"OS")
;
;---> Check that Imm History string for this patient is present.
;---> If Imm History not provided, set Error Code and quit.
I '$G(BIDFN) D ERRCD^BIUTL2(405,,1) D RESET Q
I $G(BIHX(BIDFN))']"" D ERRCD^BIUTL2(303,,1) D RESET Q
;
;---> Check that a Listman Item was passed.
I '$D(VALMY) D ERRCD^BIUTL2(406,,1) D RESET Q
N Y S Y=$O(VALMY(0))
I '$G(Y) D ERRCD^BIUTL2(406,,1) D RESET Q
;
S Y=$P(BIHX(BIDFN),U,Y)
I Y']"" D ERRCD^BIUTL2(303,,1) D RESET Q
;
D FULL^VALM1
;
;---> Display visit for confirmation.
N BIVFIEN,BIVTYPE,V S V="|"
;
S BIVTYPE=$P(Y,V)
;---> 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,,1) D RESET Q
;
;---> Set Immunization confirmation display fields and Visit IEN.
I BIVTYPE="I" D
.S X=$P(Y,V,7)_" "_$P(Y,V,2)_" "_$P(Y,V,5)
.S BIVFIEN=$P(Y,V,4)
;
;---> Set Skin Test confirmation display fields and Visit IEN.
I BIVTYPE="S" D
.S X=$P(Y,V,7)_" "_$P(Y,V,11)_" "_$P(Y,V,8)_" "_$P(Y,V,9)
.S:$P(Y,V,9) X=X_" mm"
.S X=X_" "_$P(Y,V,5)
.S BIVFIEN=$P(Y,V,4)
;
;
D TITLE^BIUTL5("DELETE AN IMMUNIZATION VISIT")
N A
S A(1)="Do you really wish to DELETE this Visit?"
S A(1,"F")="!!?3"
S A(2)="Patient: "_$E($$NAME^BIUTL1(BIDFN),1,25)
S A(2)=A(2)_" Chart#: "_$$HRCN^BIUTL1(BIDFN)
S A(2,"F")="!!?10"
S A(3)=X,A(3,"F")="!!?10"
S A(4,"F")="!"
D EN^DDIOL(.A)
;
N B,BIERR S BIERR=0
S B(1)=" Enter YES to DELETE this Visit."
S B(2)=" Enter NO to leave it unchanged."
D DIR^BIFMAN("Y",.Y,," Enter Yes or No","NO",B(2),B(1))
;
;---> Failed to confirm.
I Y<1 D Q
.D IO^BIO("NO changes made.")
.D DIRZ^BIUTL3(),RESET
;
;---> Delete the visit.
S BIERR=""
D DELETE^BIRPC3(.BIERR,BIVFIEN,BIVTYPE)
;
;---> If an error is passed back, display it.
N BI31 S BI31=$C(31)_$C(31),BIERR=$P(BIERR,BI31,2)
I BIERR]"" D IO^BIO(BIERR),DIRZ^BIUTL3()
D RESET
Q
;
;
;----------
RESET ;EP
;---> Update partition for return to Listman.
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
D HDR^BIPATVW(),INIT^BIPATVW
Q
BIPATVW2 ;IHS/CMI/MWR - ADD/EDIT/DELETE VISITS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**10**;MAY 30,2015
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;;BIB PROTOTYPE; JAN 31,2015
+4 ;; ADD, EDIT, DELETE VISITS VIA LIST MANAGER.
+5 ;; PATCH 1: Do not stuff default VFC if patient < 19 yrs. ADDIMM+33
+6 ;; PATCH 9: Add Admin Date and VIS Presented Date to array. EDITIMM+87
+7 ;; If patient is adult, set Eligibility default="V01". ADDIMM+40
+8 ;; PATCH 10: Add Skin Test Lot Number. EDITIMM+113
+9 ;
+10 ;
+11 ;----------
ADDIMM ;EP
+1 ;---> Add an Immunization via List Manager.
+2 ;---> Steps:
+3 ; 1) This entry point is called by the Protocol:
+4 ; BI IMMUNIZATION VISIT ADD, an action on the
+5 ; List Manager menu protocol: BI MENU PATIENT VIEW
+6 ;
+7 ; 2) This code calls ScreenMan form:
+8 ; BI FORM-IMM VISIT ADD/EDIT to build BI local array
+9 ; of data for add/edit of Immunization visit.
+10 ; Data already stored in the BI local array is loaded
+11 ; into the form by LOADVIS^BIUTL7, which is called
+12 ; by the Pre-Action of Blocks for Imm/Skin Edits.
+13 ;
+14 ; 3) SAVISIT^BIUTL7 uses BI local array to build data
+15 ; to pass to ADDEDIT^BIRPC3 (which is also called by
+16 ; the Broker from the GUI).
+17 ;
+18 ; 4) BIRPC3 calls ADDV^BIVISIT, which adds the
+19 ; Visit to the V Files.
+20 ;
+21 ;---> Variables:
+22 ; 1 - BIDFN (req) Patient DFN.
+23 ; 2 - BIDUZ2 (req) DUZ(2) of User (for Site Parameters).
+24 ; 3 - BIDEFDT (opt) Default date of new Visit.
+25 ;
+26 ;---> Check that DFN for this patient is present.
+27 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(405,,1)
DO RESET
QUIT
+28 ;
+29 ;
+30 ;********** BARCODE PROTO, v8.5, JAN 31,2015, IHS/CMI/MWR
+31 ;---> Parse parameter of scanned values for adding new Lot Numbers.
+32 ;N BI S BI("A")=BIDFN
+33 IF '$GET(BISCANA)
NEW BI
+34 SET BI("A")=BIDFN
+35 ;**********
+36 ;
+37 ;---> Set default VFC Eligibility.
+38 ;---> If Patient Ben Type is 01 (Am Indian/AK Native), set VFC default=4.
+39 ;
+40 ;********** PATCH 1, v8.3.1, Dec 30,2008, IHS/CMI/MWR
+41 ;---> Do NOT stuff VFC default if patient is not < 19 years old.
+42 ;I $$BENTYP^BIUTL11(BIDFN,2)="01" S BI("P")=4
+43 ;--> If patient was less than 19yrs set default=V01 and quit.
+44 ;Q:($$AGE^BIUTL1(BIDFN,1,BIDATE)>18)
+45 ;
+46 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+47 ;---> If patient is adult, set Eligibility default="V01".
+48 Begin DoDot:1
+49 IF $$AGE^BIUTL1(BIDFN,1)<19
IF $$BENTYP^BIUTL11(BIDFN,2)="01"
SET BI("P")=4
QUIT
+50 ;---> Otherwise patient is adult, set default="V01" and quit.
+51 SET BI("P")=1
End DoDot:1
+52 ;**********
+53 ;
+54 ;---> Set default date.
+55 SET BI("E")=$GET(BIDEFDT)
+56 ;
+57 ;---> Get Site IEN for parameters.
+58 IF '$GET(BIDUZ2)
SET BIDUZ2=$GET(DUZ(2))
+59 IF '$GET(BIDUZ2)
DO ERRCD^BIUTL2(105,,1)
QUIT
+60 SET BI("Z")=BIDUZ2
+61 ;
+62 ;---> Call Screenman to build BI local array of data by user.
+63 ;---> NOTE: The absence of BI("K") (IEN of Old V File entry) signals
+64 ;---> a NEW V Immunizaton.
+65 ;---> BISAVE=Flag to call BIUTL7 to save data (below). vvv83
+66 ;---> BITOLONG=Flag used in Screenman to display pop-up: Other Loc too long.
+67 NEW BISAVE,BITOLONG
+68 NEW DR
SET DR="[BI FORM-IMM VISIT ADD/EDIT]"
+69 DO DDS^BIFMAN(9000001,DR,BIDFN,"S",.BISAVE,.BIPOP)
+70 ;
+71 ;---> If user saved data, call ^BIUTL7 to save it.
+72 IF $GET(BISAVE)
DO SAVISIT^BIUTL7("I",.BI)
+73 ;
+74 DO RESET
+75 QUIT
+76 ;
+77 ;
+78 ;----------
ADDSK ;EP
+1 ;---> Add a Skin Test via List Manager.
+2 ;---> Steps are the same as ADDIMM above.
+3 ;
+4 ;---> Check that DFN for this patient is present.
+5 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(405,,1)
DO RESET
QUIT
+6 NEW BI
SET BI("A")=BIDFN
+7 ;
+8 ;---> Set default date and volume.
+9 SET BI("E")=$GET(BIDEFDT)
SET BI("W")=.1
+10 ;
+11 ;---> Get Site IEN for parameters.
+12 IF '$GET(BIDUZ2)
SET BIDUZ2=$GET(DUZ(2))
+13 IF '$GET(BIDUZ2)
DO ERRCD^BIUTL2(105,,1)
QUIT
+14 SET BI("Z")=BIDUZ2
+15 ;
+16 ;---> Call Screenman to build BI local array of data by user.
+17 ;---> NOTE: The absence of BI("K") (IEN of Old V File entry) signals
+18 ;---> a NEW V Skin Test.
+19 ;---> BISAVE=Flag to call BIUTL7 to save data (below). vvv83
+20 ;---> BITOLONG=Flag used in Screenman to display pop-up: Other Loc too long.
+21 NEW BISAVE,BITOLONG
+22 NEW DR
SET DR="[BI FORM-SKIN VISIT ADD/EDIT]"
+23 DO DDS^BIFMAN(9000001,DR,BIDFN,"S",.BISAVE,.BIPOP)
+24 ;
+25 ;---> If user saved data, call ^BIUTL7 to save it.
+26 IF $GET(BISAVE)
DO SAVISIT^BIUTL7("S",.BI)
+27 ;
+28 DO RESET
+29 QUIT
+30 ;
+31 ;
+32 ;----------
EDITIMM ;EP
+1 ;---> Edit an Immunization via List Manager.
+2 ;---> Steps:
+3 ; 1) This entry point is called by the Protocol:
+4 ; BI V FILE VISIT EDIT, an action on the
+5 ; List Manager menu protocol: BI MENU PATIENT VIEW
+6 ;
+7 ; 2) This code gets an Imm Visit from List Manager
+8 ; and loads the data into the Screenman form:
+9 ; BI FORM-IMM VISIT ADD/EDIT to build BI local array
+10 ; of data for add/edit of Immunization visit.
+11 ; Data already stored in the BI local array is loaded
+12 ; into the form by LOADVIS^BIUTL7, which is called
+13 ; by the Pre-Action of Blocks for Imm/Skin Edits.
+14 ;
+15 ; 3) SAVISIT^BIUTL7 uses BI local array to build data
+16 ; to pass to ADDEDIT^BIRPC3 (which is also called by
+17 ; the Broker from the GUI).
+18 ;
+19 ; 4) BIRPC3 calls DELETE^BIVISIT and ADDV^BIVISIT,
+20 ; which broker Visits to the V Files.
+21 ;
+22 ;
+23 ;---> Call the List Manager Generic Selector of items displayed.
+24 NEW VALMY
+25 DO EN^VALM2(XQORNOD(0),"OS")
+26 ;
+27 ;---> Check that Imm History string for this patient is present.
+28 ;---> If Imm History not supplied, set Error Code and quit.
+29 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(405,,1)
DO RESET
QUIT
+30 IF $GET(BIHX(BIDFN))']""
DO ERRCD^BIUTL2(303,,1)
DO RESET
QUIT
+31 ;
+32 ;---> Check that a Listman Item was passed; if so, set Y=which
+33 ;---> item (Imm Visit) was passed/selected.
+34 ;I '$D(VALMY) D ERRCD^BIUTL2(406,,1) D RESET Q
+35 IF '$DATA(VALMY)
DO RESET
QUIT
+36 NEW Y
SET Y=$ORDER(VALMY(0))
+37 IF '$GET(Y)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+38 ;
+39 ;---> Get V Type: Imm or Skin.
+40 NEW BIVTYPE
SET BIVTYPE=$PIECE($PIECE(BIHX(BIDFN),U,Y),"|")
+41 ;
+42 ;---> If BIVTYPE does not="I" (Immunization Visit) and it does
+43 ;---> not="S" (Skin Test Visit), then set Error Code and quit.
+44 IF ($GET(BIVTYPE)'="I")&($GET(BIVTYPE)'="S")
Begin DoDot:1
+45 DO ERRCD^BIUTL2(410,,1)
DO RESET
End DoDot:1
QUIT
+46 ;
+47 ;---> Set BIVFIEN=V File IEN.
+48 NEW BIVFIEN
SET BIVFIEN=$PIECE($PIECE(BIHX(BIDFN),U,Y),"|",4)
+49 ;
+50 ;---> Gather data for this Visit to load for Screenman edit.
+51 DO GET^BIRPC1(.Y,BIVFIEN,BIVTYPE)
+52 ;
+53 ;---> If an error is passed back, display it and quit.
+54 NEW BI31,BIERR
SET BI31=$CHAR(31)_$CHAR(31)
+55 SET BIERR=$PIECE(Y,BI31,2)
+56 IF BIERR]""
DO IO^BIO(BIERR)
DO DIRZ^BIUTL3()
DO RESET
QUIT
+57 ;
+58 ;---> If no error, then set Y=data (1st BI31 piece).
+59 SET Y=$PIECE(Y,BI31)
+60 ;
+61 ;---> Build BI array of Visit data for ScreenMan Edit form.
+62 NEW BI,DR,V
SET V="|"
+63 ;
+64 ;---> Build array for Immunization Visit.
+65 IF BIVTYPE="I"
Begin DoDot:1
+66 ;Patient DFN.
SET BI("A")=+BIDFN
+67 ;Vaccine Name IEN.
SET BI("B")=+$PIECE(Y,V,7)
+68 ;Dose# of Immunization.
SET BI("C")=$PIECE(Y,V,3)
+69 ;Lot Number IEN.
SET BI("D")=$PIECE(Y,V,9)
+70 ;Date/Time of Imm Visit (ext form).
SET BI("E")=$PIECE(Y,V,6)
+71 ;Location of Encounter IEN.
SET BI("F")=+$PIECE(Y,V,11)
+72 ;Other Location of Encounter Text.
SET BI("G")=$PIECE(Y,V,13)
+73 ;Catgegory of Visit (A,E,I).
SET BI("I")=$PIECE(Y,V,12)
+74 ;Visit IEN.
SET BI("J")=$PIECE(Y,V,22)
+75 ;Old V File IEN - indicates EDIT of previous Imm.
SET BI("K")=BIVFIEN
+76 ;Reaction to Immunization on this Visit.
SET BI("O")=+$PIECE(Y,V,15)
+77 ;VFC Eligibility. vvv83
SET BI("P")=$PIECE(Y,V,23)
+78 ;Release/Revision Date of VIS (DD-Mmm-YYYY).
SET BI("Q")=$PIECE(Y,V,17)
+79 ;Immunization Provider.
SET BI("R")=$PIECE(Y,V,18)
+80 ;Dose Override.
SET BI("S")=$PIECE(Y,V,19)
+81 ;Injection Site.
SET BI("T")=$PIECE(Y,V,20)
+82 ;Volume.
SET BI("W")=$PIECE(Y,V,21)
+83 ;Imported From Outside Source (=1).
SET BI("Y")=$PIECE(Y,V,24)
+84 ;NDC Code pointer IEN.
SET BI("H")=$PIECE(Y,V,25)
+85 ;
+86 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+87 ;---> Add VIS Presented Dateand Admin Date to array for Screenman.
+88 ;Date VIS Presented to Patient.
SET BI("QQ")=$PIECE(Y,V,30)
+89 ;Admin/shot Date ONLY (not Visit); can be null.
SET BI("EE")=$PIECE(Y,V,31)
+90 ;**********
+91 ;X ^O
+92 ;
+93 SET DR="[BI FORM-IMM VISIT ADD/EDIT]"
End DoDot:1
+94 ;
+95 ;---> Build array for Skin Test Visit.
+96 IF BIVTYPE="S"
Begin DoDot:1
+97 ;Patient DFN.
SET BI("A")=+BIDFN
+98 ;Skin Test IEN.
SET BI("B")=+$PIECE(Y,V,13)
+99 ;Date/Time of Skin Test Visit (ext form).
SET BI("E")=$PIECE(Y,V,4)
+100 ;Location of Encounter IEN.
SET BI("F")=+$PIECE(Y,V,5)
+101 ;Other Location of Encounter Text.
SET BI("G")=$PIECE(Y,V,7)
+102 ;Catgegory of Visit (A,E,I).
SET BI("I")=$PIECE(Y,V,6)
+103 ;Visit IEN.
SET BI("J")=$PIECE(Y,V,18)
+104 ;Old V File IEN (for edits).
SET BI("K")=BIVFIEN
+105 ;Skin Test Result.
SET BI("L")=$PIECE(Y,V,9)
+106 ;Skin Test Reading.
SET BI("M")=$PIECE(Y,V,10)
+107 ;Skin Test Date Read.
SET BI("N")=$PIECE(Y,V,11)
+108 ;Skin Test Provider.
SET BI("R")=$PIECE(Y,V,14)
+109 ;Injection Site.
SET BI("T")=$PIECE(Y,V,15)
+110 ;Volume.
SET BI("W")=$PIECE(Y,V,16)
+111 ;Skin Test Reader.
SET BI("X")=$PIECE(Y,V,17)
+112 ;
+113 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+114 ;---> Add Skin Test Lot Number.
+115 SET BI("LL")=$PIECE(Y,V,19)
+116 ;**********
+117 SET DR="[BI FORM-SKIN VISIT ADD/EDIT]"
End DoDot:1
+118 ;
+119 ;
+120 ;---> Get Site IEN for parameters.
+121 IF '$GET(BIDUZ2)
SET BIDUZ2=$GET(DUZ(2))
+122 IF '$GET(BIDUZ2)
DO ERRCD^BIUTL2(105,,1)
QUIT
+123 SET BI("Z")=BIDUZ2
+124 ;
+125 ;---> Call Screenman to build BI local array of data edited by user.
+126 ;---> BISAVE=Flag to call BIUTL7 to save data (below). vvv83
+127 ;---> BITOLONG=Flag used in Screenman to display pop-up: Other Loc too long.
+128 NEW BISAVE,BITOLONG
+129 DO DDS^BIFMAN(9000001,DR,BIDFN,"S",.BISAVE,.BIPOP)
+130 ;
+131 ;---> If user saved data, call ^BIUTL7 to save it.
+132 IF $GET(BISAVE)
DO SAVISIT^BIUTL7(BIVTYPE,.BI)
+133 ;
+134 DO RESET
+135 QUIT
+136 ;
+137 ;
+138 ;----------
DELETIMM ;EP
+1 ;---> Delete an Immunization or Skin Test via List Manager.
+2 ;---> Steps:
+3 ; 1) This entry point is called by the Protocol:
+4 ; BI V FILE VISIT DELETE, an action on the
+5 ; List Manager menu protocol: BI MENU PATIENT VIEW
+6 ;
+7 ; 2) This code gets an Imm or Skin Visit from List Manager
+8 ; and calls DELETE^BIRPC3 (which is also called by
+9 ; the Broker from the GUI).
+10 ;
+11 ; 5) BIRPC3 calls DELETE^BIVISIT, which will
+12 ; delete the V File entry.
+13 ;
+14 ;---> Call the List Manager Generic Selector of items displayed.
+15 NEW VALMY
+16 DO EN^VALM2(XQORNOD(0),"OS")
+17 ;
+18 ;---> Check that Imm History string for this patient is present.
+19 ;---> If Imm History not provided, set Error Code and quit.
+20 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(405,,1)
DO RESET
QUIT
+21 IF $GET(BIHX(BIDFN))']""
DO ERRCD^BIUTL2(303,,1)
DO RESET
QUIT
+22 ;
+23 ;---> Check that a Listman Item was passed.
+24 IF '$DATA(VALMY)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+25 NEW Y
SET Y=$ORDER(VALMY(0))
+26 IF '$GET(Y)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+27 ;
+28 SET Y=$PIECE(BIHX(BIDFN),U,Y)
+29 IF Y']""
DO ERRCD^BIUTL2(303,,1)
DO RESET
QUIT
+30 ;
+31 DO FULL^VALM1
+32 ;
+33 ;---> Display visit for confirmation.
+34 NEW BIVFIEN,BIVTYPE,V
SET V="|"
+35 ;
+36 SET BIVTYPE=$PIECE(Y,V)
+37 ;---> If BIVTYPE does not="I" (Immunization Visit) and it does
+38 ;---> not="S" (Skin Test Visit), then set Error Code and quit.
+39 IF ($GET(BIVTYPE)'="I")&($GET(BIVTYPE)'="S")
Begin DoDot:1
+40 DO ERRCD^BIUTL2(410,,1)
DO RESET
QUIT
End DoDot:1
QUIT
+41 ;
+42 ;---> Set Immunization confirmation display fields and Visit IEN.
+43 IF BIVTYPE="I"
Begin DoDot:1
+44 SET X=$PIECE(Y,V,7)_" "_$PIECE(Y,V,2)_" "_$PIECE(Y,V,5)
+45 SET BIVFIEN=$PIECE(Y,V,4)
End DoDot:1
+46 ;
+47 ;---> Set Skin Test confirmation display fields and Visit IEN.
+48 IF BIVTYPE="S"
Begin DoDot:1
+49 SET X=$PIECE(Y,V,7)_" "_$PIECE(Y,V,11)_" "_$PIECE(Y,V,8)_" "_$PIECE(Y,V,9)
+50 IF $PIECE(Y,V,9)
SET X=X_" mm"
+51 SET X=X_" "_$PIECE(Y,V,5)
+52 SET BIVFIEN=$PIECE(Y,V,4)
End DoDot:1
+53 ;
+54 ;
+55 DO TITLE^BIUTL5("DELETE AN IMMUNIZATION VISIT")
+56 NEW A
+57 SET A(1)="Do you really wish to DELETE this Visit?"
+58 SET A(1,"F")="!!?3"
+59 SET A(2)="Patient: "_$EXTRACT($$NAME^BIUTL1(BIDFN),1,25)
+60 SET A(2)=A(2)_" Chart#: "_$$HRCN^BIUTL1(BIDFN)
+61 SET A(2,"F")="!!?10"
+62 SET A(3)=X
SET A(3,"F")="!!?10"
+63 SET A(4,"F")="!"
+64 DO EN^DDIOL(.A)
+65 ;
+66 NEW B,BIERR
SET BIERR=0
+67 SET B(1)=" Enter YES to DELETE this Visit."
+68 SET B(2)=" Enter NO to leave it unchanged."
+69 DO DIR^BIFMAN("Y",.Y,," Enter Yes or No","NO",B(2),B(1))
+70 ;
+71 ;---> Failed to confirm.
+72 IF Y<1
Begin DoDot:1
+73 DO IO^BIO("NO changes made.")
+74 DO DIRZ^BIUTL3()
DO RESET
End DoDot:1
QUIT
+75 ;
+76 ;---> Delete the visit.
+77 SET BIERR=""
+78 DO DELETE^BIRPC3(.BIERR,BIVFIEN,BIVTYPE)
+79 ;
+80 ;---> If an error is passed back, display it.
+81 NEW BI31
SET BI31=$CHAR(31)_$CHAR(31)
SET BIERR=$PIECE(BIERR,BI31,2)
+82 IF BIERR]""
DO IO^BIO(BIERR)
DO DIRZ^BIUTL3()
+83 DO RESET
+84 QUIT
+85 ;
+86 ;
+87 ;----------
RESET ;EP
+1 ;---> Update partition for return to Listman.
+2 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+3 DO TERM^VALM0
SET VALMBCK="R"
+4 DO HDR^BIPATVW()
DO INIT^BIPATVW
+5 QUIT
