PSIVORC1 ;BIR/MLM-PROCESS INCOMPLETE IV ORDER - CONT ;31-Aug-2012 16:08;PLS
;;5.0; INPATIENT MEDICATIONS ;**1,37,69,110,157,134,1015**;16 DEC 97;Build 62
;
; Reference to ^DD("DD" is supported by DBIA 10017.
; Reference to ^DD( is supported by DBIA 2255.
; Reference to ^VA(200 is supported by DBIA 10060.
; Reference to ^%DT is supported by DBIA 10003.
; Reference to ^%DTC is supported by DBIA 10000.
; Reference to ^DID is supported by DBIA 2052.
; Reference to ^VALM is supported by DBIA 10118.
; Reference to ^PS(55 is supported by DBIA# 2191.
; Modified - IHS/MSC/MGH - 08/31/2012 - Patch 1015 added $G for variables at EDIT1
;
53 ; IV Type
I $G(PSGORD)["P",$G(PSGAT),($G(P(9))]"") D
.N X,PSGS0Y,ZZ,LYN,ZZND,ZZNDW S X=P(9) S PSGS0Y="",ZZ=0 D FIND^DIC(51.1,,,,X,,"APPSJ",,,"LYN")
.S ZZ=$O(LYN("DILIST",2,ZZ)) I ZZ S ZZ=+LYN("DILIST",2,ZZ) I ZZ S ZZND=$G(^PS(51.1,ZZ,0)) S PSGST=$P(ZZND,U,5),PSGS0XT=$P(ZZND,U,3) I $G(PSJPWD) D
..N ZZNDW S ZZNDW=$G(^PS(51.1,ZZ,1,PSJPWD,0)) I $P(ZZNDW,"^",2)]"" S PSGS0Y=$P(ZZNDW,"^",2),$P(ZZND,"^",2)=PSGS0Y
.S ZZ=0 F S ZZ=$O(LYN("DILIST",1,ZZ)) Q:'ZZ I $G(LYN("DILIST",1,ZZ))'=X K LYN("DILIST",1,ZZ),LYN("DILIST",2,ZZ),LYN("DILIST","ID",ZZ,1)
.I $D(PSJPWD) S ZZ=0 F S ZZ=$O(LYN("DILIST",2,ZZ)) Q:'ZZ I $P($G(^PS(51.1,+LYN("DILIST",2,ZZ),1,+PSJPWD,0)),U,2)]"" S PSGS0Y=$P($G(^(0)),U,2)
.I '$G(PSGS0Y) S ZZ=0 F S ZZ=$O(LYN("DILIST",2,ZZ)) Q:'ZZ Q:PSGS0Y]"" I $G(LYN("DILIST","ID",ZZ,1))]"" S PSGS0Y=$G(LYN("DILIST","ID",ZZ,1))
.Q:(PSGS0Y=PSGAT)!'$G(PSGS0Y)!($G(IVCAT)="C")
.S PSGNSTAT=1 W $C(7),!!,"PLEASE NOTE: This order's admin times (",PSGAT,")"
.W !?13," do not match the ward times (",PSGS0Y,")"
.W !?13," for this administration schedule (",P(9),")",!
.S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR K DIR W !
S DONE=0 N DIR S DIR(0)="SNA^A:ADMIXTURE;C:CHEMOTHERAPY;H:HYPERAL;P:PIGGYBACK;S:SYRINGE",DIR("A")="IV TYPE: "
I $G(P("RES"))'="R",$G(PSGORD)["P" N IVCAT,IVTYPTMP S IVCAT=$P($G(^PS(53.1,+PSGORD,2.5)),"^",5) S IVTYPTMP=$S((P(9)]""):"P",$G(P(5)):"P",$G(P(23))="P":"P",1:"")
S DIR("B")=$S($G(IVCAT)="C"!($G(IVTYPTMP)="A"):"ADMIXTURE",$G(IVCAT)="I"!($G(IVTYPTMP)="P"):"PIGGYBACK",1:"ADMIXTURE")
D DIRQ,^DIR S:$D(DTOUT)!(X="^") DONE=1 Q:DONE G:$E(X)="^" 53 S P(4)=Y D:"CS"[P(4) @P(4)
I PSIVAC'="PN" D ENT^PSIVCAL K %DT S X=P(2),%DT="RTX" D ^%DT S P(2)=+Y D ENSTOP^PSIVCAL K %DT S X=P(3),%DT="RTX" D ^%DT S P(3)=+Y
OTYP ; Get order type, display type.
S P("DTYP")=$S(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3) S:PSIVAC'="CF" P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I")
Q
;
C ; Edit Chemo order
N DIR S DIR(0)="SA^A:ADMIXTURE;P:PIGGYBACK;S:SYRINGE",DIR("A")="CHEMOTHERAPY TYPE: " D DIRQ,^DIR S:$D(DTOUT)!(X=U) DONE=1 Q:$E(X)="^"!(DONE) S P(23)=Y D:P(23)["S" S
Q
;
S ; Edit Syringe order
56 ; Intermittent Syringe
N DIR S DIR(0)="Y",DIR("??")="^S F1=53.1,F2=56 D ENHLP^PSIVORC1",DIR("A")="INTERMITTENT SYRINGE" D ^DIR Q:$D(DIRUT) S P(5)=Y
;
55 ; Syringe Size
N DA,DIR S DIR(0)="53.1,55" D ^DIR I $D(DTOUT)!$D(DUOUT) S DONE=1 Q
S P("SYRS")=Y
Q
;
DIRQ ; Set DIR("?") for IV Type prompt.
S DIR("?")="Enter a code from the list above.",DIR("??")="^S F1=55.01,F2="_$S(DIR("A")["CHEMO":106,1:.04)_" D ENHLP^PSIVORC1"
S DIR("?",1)="CHOOSE FROM:",Y=$P(DIR(0),U,2) F X=1:1:5 S DIR("?",X+1)=" "_$P($P(Y,";",X),":")_" "_$P($P(Y,";",X),":",2)
Q
;
CKFLDS ; Find required fields missing data.
NEW PSIVASX,PSIVASY,FIL,DRGTMP
S EDIT="" F PSIVASX="AD","SOL" D
.I '$D(DRG(PSIVASX)) S EDIT=EDIT_U_$S(PSIVASX="AD":57,1:58) Q
.S DNE=0 F PSIVASY=0:0 S PSIVASY=$O(DRG(PSIVASX,PSIVASY)) Q:'PSIVASY!DNE D
.. I $P(DRG(PSIVASX,PSIVASY),U,3)="" S EDIT=EDIT_U_$S(PSIVASX="AD":57,1:58),DNE=1
S:'P("MR") EDIT=EDIT_U_3 F X=8,6,2,3 I P(X)="" S EDIT=EDIT_U_$S(X=8:59,X=6:1,X=2:10,X=3:25,1:"")
I P("DTYP")=1 S:P(9)="" EDIT=EDIT_U_26 S:P(11)="" EDIT=EDIT_U_39
S:$E(EDIT,1)=U EDIT=$E(EDIT,2,999)
Q
;
DONE ; Kill variables and exit
K ACTION,AD,DFN,DNE,DONE,DONE1,DRG,DRGI,DRGN,DRGT,DRGTN,EDIT,ERR,F1,F2,FIL,HDT,J,LN,LN2,ND,ON,ON1,ON55,ORIFN,P,P16,PC,PDM,PG,PN,PNME,PNOW,PSGLMT,PSGODDD
K PSGSS,PSGSSH,PSIV,PSIVAC,PSIVAT,PSIVCV,PSIVE,PSIVHD,PSIVLN,PSIVOK,PSIVOLD,PSIVORUT,PSIVREA,PSIVSC1,PSIVSTR,PSIVSTRT,PSIVTYPE,PSIVUP,PSIVX,PSIVX1
K PSJIVORF,PSJORF,PSJORIFN,PSJORL,PSJORNP,PSJORPF,PSJORSTS,PSJIVOF,PSJNKF,PSJORD,RB,RF,SOL,STOP,TYP,UL80,WD,WDN,WG,^TMP("PSIV",$J) D ENIVKV^PSGSETU
Q
ENHLP ; order entry fields' help
N PSJHP,PSJX,PSJD
; From within this routine, F1 and F2 will refer to file 53.1,field 56, file 55.01,field 106, or file 55.01,field .04
D FIELD^DID(F1,F2,"","HELP-PROMPT","PSJHP")
I X="?",$D(PSJHP("HELP-PROMPT")) S F=$G(PSJHP("HELP-PROMPT")) W !?5 F F0=1:1:$L(F," ") S F3=$P(F," ",F0) W:$L(F3)+$X>78 !?5 W F3_" "
;
W:$D(^DD(F1,F2,12)) !,"("_^(12)_")" D FIELD^DID(F1,F2,"","XECUTABLE HELP","PSJX") I $D(PSJX("XECUTABLE HELP")) X PSJX("XECUTABLE HELP")
;
; new code
D FIELD^DID(F1,F2,"","DESCRIPTION","PSJD")
G:$S($G(X)="?":1,1:'$O(PSJD("DESCRIPTION",0))) SC F F=0:0 S F=$O(PSJD("DESCRIPTION",F)) Q:'F I $D(PSJD("DESCRIPTION",F)) W !?2,PSJD("DESCRIPTION",F)
SC ;
I F2=5!(F2=6) W !,"CHOOSE FROM:",!?8,0,?16,"NO",!?8,1,?16,"YES" Q
Q
COMPLTE ;
S P16=0,PSIVEXAM=1,(PSIVNOL,PSIVCT)=1 D GTOT^PSIVUTL(P(4)) D ^PSIVCHK I $D(DUOUT) W $C(7),!,"Order Unchanged.",! Q
G:'$D(PSIVFN1) EDIT1
I ERR=1 S Y=0 G EDIT1
D CKORD^PSIVORC2 I PSIVCHG D NOW^%DTC S P("LOG")=$E(%,1,12),P("CLRK")=DUZ_U_$P($G(^VA(200,DUZ,0)),U),P("INS")=""
W ! D ^PSIVORLB K PSIVEXAM S Y=P(2)
W !,"Start date: " X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),?30," Stop date: " S Y=P(3) X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),!
EDIT ;
I ERR=1 W !,"Please re-edit this order" K DIR S DIR(0)="E" D ^DIR K DIR W:'Y $C(7),"order unchanged." Q:'Y S Y=0 G EDIT1
;PSJ*5*157 EFD FOR IV
D EFDIV^PSJUTL($G(ZZND))
W:$G(PSIVCHG) !,"*** This change will cause a new order to be created. ***"
K DIR S DIR(0)="Y",DIR("A")="Is this O.K.",DIR("B")=$S(ERR:"NO",1:"YES"),DIR("?",1)="Enter ""Y"" to make this an active order (only allowed if no errors were"
S DIR("?")="found in order), ""N"" to edit the order, or ""^"" to leave order unchanged.",DIR("??")="^S HELP=""EDIT"" D ^PSIVHLP"
D ^DIR K DIR I $D(DIRUT) K DIRUT W $C(7),"Order unchanged." Q
;* Kill Unit dose variables when calling from ^PSJLIFNI.
I +Y,$G(PSJLIFNI) D
. K ND,ND4,ND6,NDP2
. K PSGAT,PSGCANFL,PSGDI,PSGDO,PSGDT,PSGEB,PSGEBN,PSGEFN,PSGFD,PSGFDN
. K PSGHSM,PSGLI,PSGLIN,PSGLMT,PSGMR,PSGMRN,PSGNEDFD,PSGNEF,PSGNEFD
. K PSGNESD,PSGOAT,PSGODO,PSGODT,PSGEA,PSGOEAV,PSGOEEF
. K PSGOEEWF,PSGOEEG,PSGOEF,PSGOENG,PSGOES,PSGOFD,PSGOFDN,PSGOHSM
. K PSGOINST,PSGOMR,PSGOMRN,PSGONC
. K PSGOPD,PSOPDN,PSGOPR,PSGOPRN,PSGOSD,PSGOSDN,PSGOSI,PSGOSM
. K PSGOST,PSGOSTN
. K PSGPD,PSGPDN,PSGPDRG,PSGDRGN,PSGPFLG,PSGPI,PSGPR,PSGPRIO,PSGPRN
. K PSGPTMP,PSGRRF,PSG0XT,PSGS0Y,PSGSCH,PSGSD,PSGSDN,PSGSI,PSGSM
. K PSGST,PSGSTAT,PSGSTN,PSJACNWP,PSJACOK,PSJCOI
EDIT1 ;
;IHS/MSC/MGH Added $G for variables Patch 1015
NEW XFLG,PSIVY S PSIVY=$G(Y)
NEW X S X=$G(^TMP("PSJI",$J,0)),VALMBG=$S((X<17):1,1:(X-(X#16)))
I PSIVY=0!'$G(PSIVFN1) S PSIVFN1=1 D EN^VALM("PSJ LM IV AC/EDIT") Q
S PSIVCHG=0 D EDCHK^PSIVORC2 K PSIVCHG
S VALMBCK="Q",PSIVACEP=1
Q
PSIVORC1 ;BIR/MLM-PROCESS INCOMPLETE IV ORDER - CONT ;31-Aug-2012 16:08;PLS
+1 ;;5.0; INPATIENT MEDICATIONS ;**1,37,69,110,157,134,1015**;16 DEC 97;Build 62
+2 ;
+3 ; Reference to ^DD("DD" is supported by DBIA 10017.
+4 ; Reference to ^DD( is supported by DBIA 2255.
+5 ; Reference to ^VA(200 is supported by DBIA 10060.
+6 ; Reference to ^%DT is supported by DBIA 10003.
+7 ; Reference to ^%DTC is supported by DBIA 10000.
+8 ; Reference to ^DID is supported by DBIA 2052.
+9 ; Reference to ^VALM is supported by DBIA 10118.
+10 ; Reference to ^PS(55 is supported by DBIA# 2191.
+11 ; Modified - IHS/MSC/MGH - 08/31/2012 - Patch 1015 added $G for variables at EDIT1
+12 ;
53 ; IV Type
+1 IF $GET(PSGORD)["P"
IF $GET(PSGAT)
IF ($GET(P(9))]"")
Begin DoDot:1
+2 NEW X,PSGS0Y,ZZ,LYN,ZZND,ZZNDW
SET X=P(9)
SET PSGS0Y=""
SET ZZ=0
DO FIND^DIC(51.1,,,,X,,"APPSJ",,,"LYN")
+3 SET ZZ=$ORDER(LYN("DILIST",2,ZZ))
IF ZZ
SET ZZ=+LYN("DILIST",2,ZZ)
IF ZZ
SET ZZND=$GET(^PS(51.1,ZZ,0))
SET PSGST=$PIECE(ZZND,U,5)
SET PSGS0XT=$PIECE(ZZND,U,3)
IF $GET(PSJPWD)
Begin DoDot:2
+4 NEW ZZNDW
SET ZZNDW=$GET(^PS(51.1,ZZ,1,PSJPWD,0))
IF $PIECE(ZZNDW,"^",2)]""
SET PSGS0Y=$PIECE(ZZNDW,"^",2)
SET $PIECE(ZZND,"^",2)=PSGS0Y
End DoDot:2
+5 SET ZZ=0
FOR
SET ZZ=$ORDER(LYN("DILIST",1,ZZ))
IF 'ZZ
QUIT
IF $GET(LYN("DILIST",1,ZZ))'=X
KILL LYN("DILIST",1,ZZ),LYN("DILIST",2,ZZ),LYN("DILIST","ID",ZZ,1)
+6 IF $DATA(PSJPWD)
SET ZZ=0
FOR
SET ZZ=$ORDER(LYN("DILIST",2,ZZ))
IF 'ZZ
QUIT
IF $PIECE($GET(^PS(51.1,+LYN("DILIST",2,ZZ),1,+PSJPWD,0)),U,2)]""
SET PSGS0Y=$PIECE($GET(^(0)),U,2)
+7 IF '$GET(PSGS0Y)
SET ZZ=0
FOR
SET ZZ=$ORDER(LYN("DILIST",2,ZZ))
IF 'ZZ
QUIT
IF PSGS0Y]""
QUIT
IF $GET(LYN("DILIST","ID",ZZ,1))]""
SET PSGS0Y=$GET(LYN("DILIST","ID",ZZ,1))
+8 IF (PSGS0Y=PSGAT)!'$GET(PSGS0Y)!($GET(IVCAT)="C")
QUIT
+9 SET PSGNSTAT=1
WRITE $CHAR(7),!!,"PLEASE NOTE: This order's admin times (",PSGAT,")"
+10 WRITE !?13," do not match the ward times (",PSGS0Y,")"
+11 WRITE !?13," for this administration schedule (",P(9),")",!
+12 SET DIR(0)="EA"
SET DIR("A")="Press Return to continue..."
DO ^DIR
KILL DIR
WRITE !
End DoDot:1
+13 SET DONE=0
NEW DIR
SET DIR(0)="SNA^A:ADMIXTURE;C:CHEMOTHERAPY;H:HYPERAL;P:PIGGYBACK;S:SYRINGE"
SET DIR("A")="IV TYPE: "
+14 IF $GET(P("RES"))'="R"
IF $GET(PSGORD)["P"
NEW IVCAT,IVTYPTMP
SET IVCAT=$PIECE($GET(^PS(53.1,+PSGORD,2.5)),"^",5)
SET IVTYPTMP=$SELECT((P(9)]""):"P",$GET(P(5)):"P",$GET(P(23))="P":"P",1:"")
+15 SET DIR("B")=$SELECT($GET(IVCAT)="C"!($GET(IVTYPTMP)="A"):"ADMIXTURE",$GET(IVCAT)="I"!($GET(IVTYPTMP)="P"):"PIGGYBACK",1:"ADMIXTURE")
+16 DO DIRQ
DO ^DIR
IF $DATA(DTOUT)!(X="^")
SET DONE=1
IF DONE
QUIT
IF $EXTRACT(X)="^"
GOTO 53
SET P(4)=Y
IF "CS"[P(4)
DO @P(4)
+17 IF PSIVAC'="PN"
DO ENT^PSIVCAL
KILL %DT
SET X=P(2)
SET %DT="RTX"
DO ^%DT
SET P(2)=+Y
DO ENSTOP^PSIVCAL
KILL %DT
SET X=P(3)
SET %DT="RTX"
DO ^%DT
SET P(3)=+Y
OTYP ; Get order type, display type.
+1 SET P("DTYP")=$SELECT(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3)
IF PSIVAC'="CF"
SET P("OT")=$SELECT(P(4)="A":"F",P(4)="H":"H",1:"I")
+2 QUIT
+3 ;
C ; Edit Chemo order
+1 NEW DIR
SET DIR(0)="SA^A:ADMIXTURE;P:PIGGYBACK;S:SYRINGE"
SET DIR("A")="CHEMOTHERAPY TYPE: "
DO DIRQ
DO ^DIR
IF $DATA(DTOUT)!(X=U)
SET DONE=1
IF $EXTRACT(X)="^"!(DONE)
QUIT
SET P(23)=Y
IF P(23)["S"
DO S
+2 QUIT
+3 ;
S ; Edit Syringe order
56 ; Intermittent Syringe
+1 NEW DIR
SET DIR(0)="Y"
SET DIR("??")="^S F1=53.1,F2=56 D ENHLP^PSIVORC1"
SET DIR("A")="INTERMITTENT SYRINGE"
DO ^DIR
IF $DATA(DIRUT)
QUIT
SET P(5)=Y
+2 ;
55 ; Syringe Size
+1 NEW DA,DIR
SET DIR(0)="53.1,55"
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET DONE=1
QUIT
+2 SET P("SYRS")=Y
+3 QUIT
+4 ;
DIRQ ; Set DIR("?") for IV Type prompt.
+1 SET DIR("?")="Enter a code from the list above."
SET DIR("??")="^S F1=55.01,F2="_$SELECT(DIR("A")["CHEMO":106,1:.04)_" D ENHLP^PSIVORC1"
+2 SET DIR("?",1)="CHOOSE FROM:"
SET Y=$PIECE(DIR(0),U,2)
FOR X=1:1:5
SET DIR("?",X+1)=" "_$PIECE($PIECE(Y,";",X),":")_" "_$PIECE($PIECE(Y,";",X),":",2)
+3 QUIT
+4 ;
CKFLDS ; Find required fields missing data.
+1 NEW PSIVASX,PSIVASY,FIL,DRGTMP
+2 SET EDIT=""
FOR PSIVASX="AD","SOL"
Begin DoDot:1
+3 IF '$DATA(DRG(PSIVASX))
SET EDIT=EDIT_U_$SELECT(PSIVASX="AD":57,1:58)
QUIT
+4 SET DNE=0
FOR PSIVASY=0:0
SET PSIVASY=$ORDER(DRG(PSIVASX,PSIVASY))
IF 'PSIVASY!DNE
QUIT
Begin DoDot:2
+5 IF $PIECE(DRG(PSIVASX,PSIVASY),U,3)=""
SET EDIT=EDIT_U_$SELECT(PSIVASX="AD":57,1:58)
SET DNE=1
End DoDot:2
End DoDot:1
+6 IF 'P("MR")
SET EDIT=EDIT_U_3
FOR X=8,6,2,3
IF P(X)=""
SET EDIT=EDIT_U_$SELECT(X=8:59,X=6:1,X=2:10,X=3:25,1:"")
+7 IF P("DTYP")=1
IF P(9)=""
SET EDIT=EDIT_U_26
IF P(11)=""
SET EDIT=EDIT_U_39
+8 IF $EXTRACT(EDIT,1)=U
SET EDIT=$EXTRACT(EDIT,2,999)
+9 QUIT
+10 ;
DONE ; Kill variables and exit
+1 KILL ACTION,AD,DFN,DNE,DONE,DONE1,DRG,DRGI,DRGN,DRGT,DRGTN,EDIT,ERR,F1,F2,FIL,HDT,J,LN,LN2,ND,ON,ON1,ON55,ORIFN,P,P16,PC,PDM,PG,PN,PNME,PNOW,PSGLMT,PSGODDD
+2 KILL PSGSS,PSGSSH,PSIV,PSIVAC,PSIVAT,PSIVCV,PSIVE,PSIVHD,PSIVLN,PSIVOK,PSIVOLD,PSIVORUT,PSIVREA,PSIVSC1,PSIVSTR,PSIVSTRT,PSIVTYPE,PSIVUP,PSIVX,PSIVX1
+3 KILL PSJIVORF,PSJORF,PSJORIFN,PSJORL,PSJORNP,PSJORPF,PSJORSTS,PSJIVOF,PSJNKF,PSJORD,RB,RF,SOL,STOP,TYP,UL80,WD,WDN,WG,^TMP("PSIV",$JOB)
DO ENIVKV^PSGSETU
+4 QUIT
ENHLP ; order entry fields' help
+1 NEW PSJHP,PSJX,PSJD
+2 ; From within this routine, F1 and F2 will refer to file 53.1,field 56, file 55.01,field 106, or file 55.01,field .04
+3 DO FIELD^DID(F1,F2,"","HELP-PROMPT","PSJHP")
+4 IF X="?"
IF $DATA(PSJHP("HELP-PROMPT"))
SET F=$GET(PSJHP("HELP-PROMPT"))
WRITE !?5
FOR F0=1:1:$LENGTH(F," ")
SET F3=$PIECE(F," ",F0)
IF $LENGTH(F3)+$X>78
WRITE !?5
WRITE F3_" "
+5 ;
+6 IF $DATA(^DD(F1,F2,12))
WRITE !,"("_^(12)_")"
DO FIELD^DID(F1,F2,"","XECUTABLE HELP","PSJX")
IF $DATA(PSJX("XECUTABLE HELP"))
XECUTE PSJX("XECUTABLE HELP")
+7 ;
+8 ; new code
+9 DO FIELD^DID(F1,F2,"","DESCRIPTION","PSJD")
+10 IF $SELECT($GET(X)="?"
GOTO SC
FOR F=0:0
SET F=$ORDER(PSJD("DESCRIPTION",F))
IF 'F
QUIT
IF $DATA(PSJD("DESCRIPTION",F))
WRITE !?2,PSJD("DESCRIPTION",F)
SC ;
+1 IF F2=5!(F2=6)
WRITE !,"CHOOSE FROM:",!?8,0,?16,"NO",!?8,1,?16,"YES"
QUIT
+2 QUIT
COMPLTE ;
+1 SET P16=0
SET PSIVEXAM=1
SET (PSIVNOL,PSIVCT)=1
DO GTOT^PSIVUTL(P(4))
DO ^PSIVCHK
IF $DATA(DUOUT)
WRITE $CHAR(7),!,"Order Unchanged.",!
QUIT
+2 IF '$DATA(PSIVFN1)
GOTO EDIT1
+3 IF ERR=1
SET Y=0
GOTO EDIT1
+4 DO CKORD^PSIVORC2
IF PSIVCHG
DO NOW^%DTC
SET P("LOG")=$EXTRACT(%,1,12)
SET P("CLRK")=DUZ_U_$PIECE($GET(^VA(200,DUZ,0)),U)
SET P("INS")=""
+5 WRITE !
DO ^PSIVORLB
KILL PSIVEXAM
SET Y=P(2)
+6 WRITE !,"Start date: "
XECUTE ^DD("DD")
WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2),?30," Stop date: "
SET Y=P(3)
XECUTE ^DD("DD")
WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2),!
EDIT ;
+1 IF ERR=1
WRITE !,"Please re-edit this order"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
WRITE $CHAR(7),"order unchanged."
IF 'Y
QUIT
SET Y=0
GOTO EDIT1
+2 ;PSJ*5*157 EFD FOR IV
+3 DO EFDIV^PSJUTL($GET(ZZND))
+4 IF $GET(PSIVCHG)
WRITE !,"*** This change will cause a new order to be created. ***"
+5 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Is this O.K."
SET DIR("B")=$SELECT(ERR:"NO",1:"YES")
SET DIR("?",1)="Enter ""Y"" to make this an active order (only allowed if no errors were"
+6 SET DIR("?")="found in order), ""N"" to edit the order, or ""^"" to leave order unchanged."
SET DIR("??")="^S HELP=""EDIT"" D ^PSIVHLP"
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
KILL DIRUT
WRITE $CHAR(7),"Order unchanged."
QUIT
+8 ;* Kill Unit dose variables when calling from ^PSJLIFNI.
+9 IF +Y
IF $GET(PSJLIFNI)
Begin DoDot:1
+10 KILL ND,ND4,ND6,NDP2
+11 KILL PSGAT,PSGCANFL,PSGDI,PSGDO,PSGDT,PSGEB,PSGEBN,PSGEFN,PSGFD,PSGFDN
+12 KILL PSGHSM,PSGLI,PSGLIN,PSGLMT,PSGMR,PSGMRN,PSGNEDFD,PSGNEF,PSGNEFD
+13 KILL PSGNESD,PSGOAT,PSGODO,PSGODT,PSGEA,PSGOEAV,PSGOEEF
+14 KILL PSGOEEWF,PSGOEEG,PSGOEF,PSGOENG,PSGOES,PSGOFD,PSGOFDN,PSGOHSM
+15 KILL PSGOINST,PSGOMR,PSGOMRN,PSGONC
+16 KILL PSGOPD,PSOPDN,PSGOPR,PSGOPRN,PSGOSD,PSGOSDN,PSGOSI,PSGOSM
+17 KILL PSGOST,PSGOSTN
+18 KILL PSGPD,PSGPDN,PSGPDRG,PSGDRGN,PSGPFLG,PSGPI,PSGPR,PSGPRIO,PSGPRN
+19 KILL PSGPTMP,PSGRRF,PSG0XT,PSGS0Y,PSGSCH,PSGSD,PSGSDN,PSGSI,PSGSM
+20 KILL PSGST,PSGSTAT,PSGSTN,PSJACNWP,PSJACOK,PSJCOI
End DoDot:1
EDIT1 ;
+1 ;IHS/MSC/MGH Added $G for variables Patch 1015
+2 NEW XFLG,PSIVY
SET PSIVY=$GET(Y)
+3 NEW X
SET X=$GET(^TMP("PSJI",$JOB,0))
SET VALMBG=$SELECT((X<17):1,1:(X-(X#16)))
+4 IF PSIVY=0!'$GET(PSIVFN1)
SET PSIVFN1=1
DO EN^VALM("PSJ LM IV AC/EDIT")
QUIT
+5 SET PSIVCHG=0
DO EDCHK^PSIVORC2
KILL PSIVCHG
+6 SET VALMBCK="Q"
SET PSIVACEP=1
+7 QUIT
