BIPATCO2 ;IHS/CMI/MWR - ADD/DELETE CONTRAINDICATIONS; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; ADD AND DELETE CONTRAINDICATIONS VIA LISTMANAGER.
;
;
;----------
ADDCON ;EP
;---> Add a Contraindication via List Manager.
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI CONTRAINDICATION ADD, an action on the
; List Manager menu protocol: BI MENU CONTRAINDICATIONS.
;
; 2) This code calls ScreenMan form:
; BI FORM-CONTRAIND ADD/EDIT to add a contraindication.
;
; 3) SAVCONTR^BIUTL7 uses BI local array to build data
; to pass to ADD^BIRPC4 (which is also called by
; the Broker from the GUI).
;
; 4) BIRPC4 adds the BI CONTRAINDICATION entry.
;
;---> 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
;
;
;---> Call Screenman to build BI local array of data by user.
N BISAVE
N DR S DR="[BI FORM-CONTRAIND ADD/EDIT]"
D DDS^BIFMAN(9000001,DR,BIDFN,"S",.BISAVE,.BIPOP)
;
;---> If user saved data, call ^BIUTL7 to save it.
D:$G(BISAVE) SAVCONTR^BIUTL7(.BI)
;
D RESET
Q
;
;
;----------
EDITCON ;EP
;---> Edit a Contraindication via List Manager.
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI CONTRAINDICATION EDIT, an action on the
; List Manager menu protocol: BI MENU CONTRAINDICATIONS.
;
; 2) This code gets a Contraindication from List Manager
; and calls the ScreenMan form: BI FORM-CONTRAIND ADD/EDIT
; to edit the contraindication.
;
; 3) BIRPC4 deletes the BI CONTRAINDICATION entry.
;
;
;---> Check that Contraindication string for this patient is
;---> present; if not, set Error Code and quit.
I '$G(BIDFN) D ERRCD^BIUTL2(415,,1) D RESET Q
I $G(BICONT(BIDFN))="" D ERRCD^BIUTL2(313,,1) D RESET Q
;
;---> Call the Listmanager Generic Selector of items displayed.
N VALMY
D EN^VALM2(XQORNOD(0),"OS")
;
;---> Check that a Listman Item was passed.
I '$D(VALMY) D ERRCD^BIUTL2(406,,1) D RESET Q
;---> Now set Y=Item# selected from the list.
N Y S Y=$O(VALMY(0))
I '$G(Y) D ERRCD^BIUTL2(406,,1) D RESET Q
;
S Y=$P(BICONT(BIDFN),U,Y)
I Y']"" D ERRCD^BIUTL2(303,,1) D RESET Q
;
N BI,BIDIEN
S BI("A")=BIDFN ;Patient DFN.
S BI("I")=$P(Y,"|",1) ;IEN of this Contraindication.
S BICONTDA=BI("I") ;Save IEN of olf Contraindication to delete below.
;
S BI("B")=$P($G(^BIPC(BI("I"),0)),U,2) ;Vaccine IEN.
I 'BI("B") D ERRCD^BIUTL2(418,,1) D RESET Q
;
S BI("C")=$P(Y,"|",3) ;Reason (external text).
S BI("D")=$P(Y,"|",4) ;Date (external text).
;---> Change Date to internal (in case Screenman doesn't get a chance).
D
.N X,Y,%DT S X=BI("D") D ^%DT
.S BI("D")=Y
;
;--->Flag: If N=1 this is an EDIT.
S BI("N")=1
;
;---> Call Screenman to build BI local array of data by user.
N BIERR,BISAVE
N DR S DR="[BI FORM-CONTRAIND ADD/EDIT]"
D DDS^BIFMAN(9000001,DR,BIDFN,"S",.BISAVE,.BIPOP)
;
;---> If user saved data, file it.
I $G(BISAVE) D
.D SAVCONTR^BIUTL7(.BI,.BIERR)
.Q:($G(BIERR)]"")
.;---> Now delete old (original) Contraindication.
.D:$G(BICONTDA) DELCONT^BIRPC4(,BICONTDA)
;
D RESET
Q
;
;
;----------
DELETCON ;EP
;---> Delete a Contraindication via List Manager.
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI CONTRAINDICATION DELETE, an action on the
; List Manager menu protocol: BI MENU CONTRAINDICATIONS.
;
; 2) This code gets a Contraindication from List Manager
; and calls DELCONT^BIRPC4 (which is also called by
; the Broker from the GUI).
;
; 3) BIRPC4 deletes the BI CONTRAINDICATION entry.
;
;
;---> Check that Contraindication string for this patient is
;---> present; if not, set Error Code and quit.
I '$G(BIDFN) D ERRCD^BIUTL2(415,,1) D RESET Q
I $G(BICONT(BIDFN))="" D ERRCD^BIUTL2(313,,1) D RESET Q
;
;---> Call the Listmanager Generic Selector of items displayed.
N VALMY
D EN^VALM2(XQORNOD(0),"OS")
;
;---> Check that a Listman Item was passed.
I '$D(VALMY) D ERRCD^BIUTL2(406,,1) D RESET Q
;---> Now set Y=Item# selected from the list.
N Y S Y=$O(VALMY(0))
I '$G(Y) D ERRCD^BIUTL2(406,,1) D RESET Q
;
S Y=$P(BICONT(BIDFN),U,Y)
I Y']"" D ERRCD^BIUTL2(303,,1) D RESET Q
;
D FULL^VALM1
;
;---> Display contraindication for confirmation.
;---> Set Contraindication confirmation display and IEN.
N BICONTDA,V S V="|"
S X=$P(Y,V,2)_": "_$P(Y,V,3)_" "_$P(Y,V,4)
;---> BICONTDA=DA of Contraindication to be deleted.
S BICONTDA=$P(Y,V)
;
D TITLE^BIUTL5("DELETE A CONTRAINDICATION")
N A
S A(1)="Do you really wish to DELETE this Contraindication?"
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,BIPOP S BIPOP=0
S B(1)=" Enter YES to DELETE this Contraindication."
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 BIPOP=""
D DELCONT^BIRPC4(.BIPOP,BICONTDA)
;
;---> If an error is passed back, display it.
N BI31 S BI31=$C(31)_$C(31),BIPOP=$P(BIPOP,BI31,2)
I BIPOP]"" D IO^BIO(BIPOP),DIRZ^BIUTL3()
D RESET
Q
;
;
;----------
RESET ;EP
;---> Update partition for return to Listmanager.
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
D INIT^BIPATCO,HDR^BIPATCO
Q
BIPATCO2 ;IHS/CMI/MWR - ADD/DELETE CONTRAINDICATIONS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; ADD AND DELETE CONTRAINDICATIONS VIA LISTMANAGER.
+4 ;
+5 ;
+6 ;----------
ADDCON ;EP
+1 ;---> Add a Contraindication via List Manager.
+2 ;---> Steps:
+3 ; 1) This entry point is called by the Protocol:
+4 ; BI CONTRAINDICATION ADD, an action on the
+5 ; List Manager menu protocol: BI MENU CONTRAINDICATIONS.
+6 ;
+7 ; 2) This code calls ScreenMan form:
+8 ; BI FORM-CONTRAIND ADD/EDIT to add a contraindication.
+9 ;
+10 ; 3) SAVCONTR^BIUTL7 uses BI local array to build data
+11 ; to pass to ADD^BIRPC4 (which is also called by
+12 ; the Broker from the GUI).
+13 ;
+14 ; 4) BIRPC4 adds the BI CONTRAINDICATION entry.
+15 ;
+16 ;---> Check that DFN for this patient is present.
+17 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(405,,1)
DO RESET
QUIT
+18 NEW BI
SET BI("A")=BIDFN
+19 ;
+20 ;
+21 ;---> Call Screenman to build BI local array of data by user.
+22 NEW BISAVE
+23 NEW DR
SET DR="[BI FORM-CONTRAIND ADD/EDIT]"
+24 DO DDS^BIFMAN(9000001,DR,BIDFN,"S",.BISAVE,.BIPOP)
+25 ;
+26 ;---> If user saved data, call ^BIUTL7 to save it.
+27 IF $GET(BISAVE)
DO SAVCONTR^BIUTL7(.BI)
+28 ;
+29 DO RESET
+30 QUIT
+31 ;
+32 ;
+33 ;----------
EDITCON ;EP
+1 ;---> Edit a Contraindication via List Manager.
+2 ;---> Steps:
+3 ; 1) This entry point is called by the Protocol:
+4 ; BI CONTRAINDICATION EDIT, an action on the
+5 ; List Manager menu protocol: BI MENU CONTRAINDICATIONS.
+6 ;
+7 ; 2) This code gets a Contraindication from List Manager
+8 ; and calls the ScreenMan form: BI FORM-CONTRAIND ADD/EDIT
+9 ; to edit the contraindication.
+10 ;
+11 ; 3) BIRPC4 deletes the BI CONTRAINDICATION entry.
+12 ;
+13 ;
+14 ;---> Check that Contraindication string for this patient is
+15 ;---> present; if not, set Error Code and quit.
+16 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(415,,1)
DO RESET
QUIT
+17 IF $GET(BICONT(BIDFN))=""
DO ERRCD^BIUTL2(313,,1)
DO RESET
QUIT
+18 ;
+19 ;---> Call the Listmanager Generic Selector of items displayed.
+20 NEW VALMY
+21 DO EN^VALM2(XQORNOD(0),"OS")
+22 ;
+23 ;---> Check that a Listman Item was passed.
+24 IF '$DATA(VALMY)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+25 ;---> Now set Y=Item# selected from the list.
+26 NEW Y
SET Y=$ORDER(VALMY(0))
+27 IF '$GET(Y)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+28 ;
+29 SET Y=$PIECE(BICONT(BIDFN),U,Y)
+30 IF Y']""
DO ERRCD^BIUTL2(303,,1)
DO RESET
QUIT
+31 ;
+32 NEW BI,BIDIEN
+33 ;Patient DFN.
SET BI("A")=BIDFN
+34 ;IEN of this Contraindication.
SET BI("I")=$PIECE(Y,"|",1)
+35 ;Save IEN of olf Contraindication to delete below.
SET BICONTDA=BI("I")
+36 ;
+37 ;Vaccine IEN.
SET BI("B")=$PIECE($GET(^BIPC(BI("I"),0)),U,2)
+38 IF 'BI("B")
DO ERRCD^BIUTL2(418,,1)
DO RESET
QUIT
+39 ;
+40 ;Reason (external text).
SET BI("C")=$PIECE(Y,"|",3)
+41 ;Date (external text).
SET BI("D")=$PIECE(Y,"|",4)
+42 ;---> Change Date to internal (in case Screenman doesn't get a chance).
+43 Begin DoDot:1
+44 NEW X,Y,%DT
SET X=BI("D")
DO ^%DT
+45 SET BI("D")=Y
End DoDot:1
+46 ;
+47 ;--->Flag: If N=1 this is an EDIT.
+48 SET BI("N")=1
+49 ;
+50 ;---> Call Screenman to build BI local array of data by user.
+51 NEW BIERR,BISAVE
+52 NEW DR
SET DR="[BI FORM-CONTRAIND ADD/EDIT]"
+53 DO DDS^BIFMAN(9000001,DR,BIDFN,"S",.BISAVE,.BIPOP)
+54 ;
+55 ;---> If user saved data, file it.
+56 IF $GET(BISAVE)
Begin DoDot:1
+57 DO SAVCONTR^BIUTL7(.BI,.BIERR)
+58 IF ($GET(BIERR)]"")
QUIT
+59 ;---> Now delete old (original) Contraindication.
+60 IF $GET(BICONTDA)
DO DELCONT^BIRPC4(,BICONTDA)
End DoDot:1
+61 ;
+62 DO RESET
+63 QUIT
+64 ;
+65 ;
+66 ;----------
DELETCON ;EP
+1 ;---> Delete a Contraindication via List Manager.
+2 ;---> Steps:
+3 ; 1) This entry point is called by the Protocol:
+4 ; BI CONTRAINDICATION DELETE, an action on the
+5 ; List Manager menu protocol: BI MENU CONTRAINDICATIONS.
+6 ;
+7 ; 2) This code gets a Contraindication from List Manager
+8 ; and calls DELCONT^BIRPC4 (which is also called by
+9 ; the Broker from the GUI).
+10 ;
+11 ; 3) BIRPC4 deletes the BI CONTRAINDICATION entry.
+12 ;
+13 ;
+14 ;---> Check that Contraindication string for this patient is
+15 ;---> present; if not, set Error Code and quit.
+16 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(415,,1)
DO RESET
QUIT
+17 IF $GET(BICONT(BIDFN))=""
DO ERRCD^BIUTL2(313,,1)
DO RESET
QUIT
+18 ;
+19 ;---> Call the Listmanager Generic Selector of items displayed.
+20 NEW VALMY
+21 DO EN^VALM2(XQORNOD(0),"OS")
+22 ;
+23 ;---> Check that a Listman Item was passed.
+24 IF '$DATA(VALMY)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+25 ;---> Now set Y=Item# selected from the list.
+26 NEW Y
SET Y=$ORDER(VALMY(0))
+27 IF '$GET(Y)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+28 ;
+29 SET Y=$PIECE(BICONT(BIDFN),U,Y)
+30 IF Y']""
DO ERRCD^BIUTL2(303,,1)
DO RESET
QUIT
+31 ;
+32 DO FULL^VALM1
+33 ;
+34 ;---> Display contraindication for confirmation.
+35 ;---> Set Contraindication confirmation display and IEN.
+36 NEW BICONTDA,V
SET V="|"
+37 SET X=$PIECE(Y,V,2)_": "_$PIECE(Y,V,3)_" "_$PIECE(Y,V,4)
+38 ;---> BICONTDA=DA of Contraindication to be deleted.
+39 SET BICONTDA=$PIECE(Y,V)
+40 ;
+41 DO TITLE^BIUTL5("DELETE A CONTRAINDICATION")
+42 NEW A
+43 SET A(1)="Do you really wish to DELETE this Contraindication?"
+44 SET A(1,"F")="!!?3"
+45 SET A(2)="Patient: "_$EXTRACT($$NAME^BIUTL1(BIDFN),1,25)
+46 SET A(2)=A(2)_" Chart#: "_$$HRCN^BIUTL1(BIDFN)
+47 SET A(2,"F")="!!?10"
+48 SET A(3)=X
SET A(3,"F")="!!?10"
+49 SET A(4,"F")="!"
+50 DO EN^DDIOL(.A)
+51 ;
+52 NEW B,BIPOP
SET BIPOP=0
+53 SET B(1)=" Enter YES to DELETE this Contraindication."
+54 SET B(2)=" Enter NO to leave it unchanged."
+55 DO DIR^BIFMAN("Y",.Y,," Enter Yes or No","NO",B(2),B(1))
+56 ;
+57 ;---> Failed to confirm.
+58 IF Y<1
Begin DoDot:1
+59 DO IO^BIO("NO changes made.")
+60 DO DIRZ^BIUTL3()
DO RESET
End DoDot:1
QUIT
+61 ;
+62 ;---> Delete the visit.
+63 SET BIPOP=""
+64 DO DELCONT^BIRPC4(.BIPOP,BICONTDA)
+65 ;
+66 ;---> If an error is passed back, display it.
+67 NEW BI31
SET BI31=$CHAR(31)_$CHAR(31)
SET BIPOP=$PIECE(BIPOP,BI31,2)
+68 IF BIPOP]""
DO IO^BIO(BIPOP)
DO DIRZ^BIUTL3()
+69 DO RESET
+70 QUIT
+71 ;
+72 ;
+73 ;----------
RESET ;EP
+1 ;---> Update partition for return to Listmanager.
+2 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+3 DO TERM^VALM0
SET VALMBCK="R"
+4 DO INIT^BIPATCO
DO HDR^BIPATCO
+5 QUIT
