PSJLIACT ;BIR/MV-IV ACTION ;29-May-2012 14:38;PLS
;;5.0; INPATIENT MEDICATIONS ;**15,47,62,58,82,97,80,1013,110,111,134,1015**;16 DEC 97;Build 62
;
; Reference to ^PS(55 is supported by DBIA 2191.
; Reference to MAIN^TIUEDIT is supported by DBIA 2410.
;
; Modified - IHS/MSC/PLS - 10/17/2011 - Line DC+1
DC ; Discontinue order
N INCOM
D HOLDHDR^PSJOE
S PSJCOM=+$S(PSJORD["V":$P($G(^PS(55,DFN,"IV",+PSJORD,.2)),"^",8),1:$P($G(^PS(53.1,+PSJORD,.2)),"^",8))
I PSJCOM W !!,"This order is part of a complex order. If you discontinue this order the",!,"following orders will be discontinued too (unless the stop date has already",!,"been reached)." D CMPLX^PSJCOM1(PSGP,PSJCOM,PSJORD)
I PSJCOM F W !!,"Do you want to discontinue this order" S %=1 D YN^DICN Q:% D ENCOM^PSGOEM
I PSJCOM,%'=1 S VALMBK="" Q
I PSJORD["V" D DC^PSIVORA,EN^PSJLIORD(DFN,ON) Q
D:PSJORD["P" DISCONT^PSIVORC
S VALMBCK="Q"
Q
ACEDIT ; Display LM screen and AC and EDit actions
D EN^PSJLIVMD
S VALMBCK=$S($G(PSIVACEP):"Q",1:"R")
Q
AEEXIT ; Call for EXIT CODE in PSJ LM IV AC/EDIT
D:ON["V" GT55^PSIVORFB
I ON["P" D GT531^PSIVORFA(DFN,ON) D:P("OT")'="I" GTDATA^PSJLIFN
D EN^PSJLIVMD
K PSIVENO
Q
EDIT ; Edit order
K PSIVFN1 NEW PSIVNBD
I $D(PSGACT),PSGACT'["E" W !,"This order may not be edited." D PAUSE^VALM1 Q
D EDIT1
Q:$D(PSIVNBD)!($G(PSIVCOPY)&'$G(PSIVENO))
D EN^PSJLIVMD
S VALMBCK=$S($G(PSIVFN1):"Q",1:"R")
Q
EDIT1 ;
;Ensure P() is defined
I $D(P)<10 S XQORQUIT=1,P("PON")="",PSIVNBD=1 D Q
.W !,"WARNING: An error has occurred. Changes will not be saved"
.D PAUSE^VALM1
.S VALMBCK="Q"
I "ANP"'[P(17) W !,"You cannot edit an inactive order" D PAUSE^VALM1 Q
S:$G(ON55)="" ON55=$G(PSJORD)
D HOLDHDR^PSJOE
;* Edit a new back door order
I ($G(ON55)["V"&($G(P("21FLG"))="")) D Q
. D GSTRING^PSIVORE1,GTFLDS^PSIVORFE
. I $G(ON55)["V",'$G(DONE) D OK^PSIVORE
. S VALMBCK="Q",PSIVNBD=1
;* Edit an active order
I $G(ON55)["V" NEW PSJEDIT1 D E^PSIVOPT1 D Q
. I $G(PSJIVBD) K PSJIVBD D EN^PSJLIORD(DFN,ON)
I $G(ON55)["P" D EDIT^PSIVORC ;Edit incomplete order.
K P("OVRIDE")
Q
ACCEPT ; Accept order
D HOLDHDR^PSJOE
;Accept IV from back door.
I $G(PSJIVBD) K PSJIVBD D OK^PSIVORE S VALMBCK="Q" Q
I ON["V" D ACCEPT^PSIVOPT1 Q
S PSIVFN1=1
D COMPLTE^PSIVORC1
S VALMBCK="Q"
Q
R ; Renewal
S PSJREN=1
D HOLDHDR^PSJOE
NEW PSIVAC S PSIVAC="PR" K PSGFDX
D R^PSIVOPT
D EN^PSJLIORD(DFN,ON)
K PSJREN
Q
H ; Hold
NEW TEX S TEX="Active order ***"
D HOLDHDR^PSJOE
D H^PSIVOPT(DFN,ON,P(17),P(3))
D:P(17)="A" PAUSE^VALM1
D EN^PSJLIORD(DFN,ON)
Q
L ; Activity Log
NEW PSIVLAB,PSIVLOG,PSJHIS S (PSIVLAB,PSIVLOG)=1
D EN^PSIVVW1
D EN^PSJLIVMD
S VALMBCK="R"
Q
O ; On Call
NEW TEX S TEX="Active order ***"
D HOLDHDR^PSJOE
D O^PSIVOPT(DFN,ON,P(17),P(3))
D:P(17)="A" PAUSE^VALM1
D EN^PSJLIORD(DFN,ON)
Q
VF ; Make the order active
NEW PSIVCHG S PSIVCHG=0
I ON["V" S ON55=ON D VF1("V","ORDER VERIFIED BY ",1) Q
D ACTIVE^PSIVORC2
Q
VF1(PSIVREA,PSIVAL,PSIVLOG) ;
;Update 4 node and set activity log.
;PSIVREA: the reason use by LOG^PSIVORAL
;PSIVAL : the description reason
;PSIVLOG: Log an activity if = 1
I '+$G(OD)!($L($G(OD))>16) K OD
D:+PSJSYSU=3 ^PSIVORE1
NEW DIE,DA,DR,PSJX,XX,PSIVACT,PSJRQND
S PSIVACT=1
S PSJX=$G(^PS(55,DFN,"IV",+ON55,4)),XX=""
I $P(PSJX,U)="" S XX=";143////0"
I $P(PSJX,U,4)="" S XX=XX_U_";142////0"
D NOW^%DTC
S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON55,DA(1)=DFN
I +PSJSYSU=3 S DR="140////"_DUZ_";141////"_$E(%,1,12)_";142////1"_$P(XX,U)
I +PSJSYSU=1 S DR="16////"_DUZ_";17////"_$E(%,1,12)_";143////1"_$P(XX,U,2)
I $G(P("PRY"))="D" S DR=DR_";.22////"_+P("IVRM")
D ^DIE
; If pending IV renew is edited during finish, go back and DE the original active order left in RENEWED status
S PREREN=$S(ON55["V":$G(@(DIE_"+ON55,2)")),1:""),PREREN=$P(PREREN,"^",5) I PREREN D K PREREN
. I PREREN["P" S PREREN=$G(@("^PS(53.1,+PREREN,0)")),PREREN=$P(PREREN,"^",25)
. I PREREN["V" N PRERENOD S PRERENOD=$G(@("^PS(55,DFN,""IV"",+PREREN,0)")) I $P(PRERENOD,"^",17)="R",($G(P("RES"))="E") D
.. S DIE="^PS(55,"_DFN_",""IV"",",DA=+PREREN,DA(1)=DFN
.. S DR="100////D;.03////"_PSGDT S ORIGSTOP=$P($G(@("^PS(55,DFN,""IV"",+PREREN,2)")),"^",3) I ORIGSTOP S DR=DR_";116////"_ORIGSTOP
.. D ^DIE D EN1^PSJHL2(DFN,"SC",PREREN)
K DR,DIE,DA
I (+PSJSYSU=3)&($G(P("PRY"))="D") D
.N DIR W ! S DIR(0)="S^Y:Yes;N:No",DIR("A")="Do you want to enter a Progress Note",DIR("B")="No" D ^DIR
.Q:Y="N"
.D MAIN^TIUEDIT(3,.TIUDA,DFN,"","","","",1)
Q:'$G(PSIVLOG)
I $G(P("PACT"))]"",+$P(P("PACT"),U,2),+$P(P("PACT"),U,3) D
. NEW DIC,DA,X,Y,XX,DO D NAME^PSJBCMA1($P(P("PACT"),U,2),.XX)
. S DIC(0)="L",DA(1)=DFN,DA(2)=+ON55,X=1
. S DIC="^PS(55,"_DA(1)_",""IV"","_DA(2)_",""A"","
. S DIC("DR")=".02////F;.03////"_XX_";.04////"_$P($G(^PS(53.3,+$P(P("PACT"),U,3),0)),U)_";.05////"_$P(P("PACT"),U)_";.06////"_$P(P("PACT"),U,2)
. D FILE^DICN
NEW PSIVALCK
S PSIVREA="V",PSIVALT=""
S PSIVAL=PSIVAL_$S(+PSJSYSU=3:"PHARMACIST",1:"NURSE")
D LOG^PSIVORAL K PSIVAL,PSIVREA,PSIVLN
I $G(PSJORD)["P" S PSIVREA="V",PSIVALT="",PSGRDTX=$G(^PS(53.1,+PSJORD,2.5)) D
. I $G(PSGRDTX) S PSIVAL="Requested Start Date: "_$$ENDTC^PSGMI($$DATE2^PSJUTL2($P(PSGRDTX,U))) D LOG^PSIVORAL
. I $P(PSGRDTX,U,3) S PSIVREA="V",PSIVALT="" S PSIVAL="Requested Stop Date: "_$$ENDTC^PSGMI($$DATE2^PSJUTL2($P(PSGRDTX,U,3))) D LOG^PSIVORAL
N DUR I $G(PSJORD) S DUR=$$GETDUR^PSJLIVMD(DFN,+PSJORD,$S(PSJORD["P":"P",1:"IV"),1) I DUR]"" D
. K DR S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON55,DA(1)=DFN
. S DR=$S($G(IVLIMIT):"152////"_DUR,1:"151////"_DUR) K IVLIMIT
. D ^DIE
D EN1^PSJHL2(DFN,"SC",ON55)
D:+PSJSYSU=1 EN1^PSJHL2(DFN,"ZV",ON55)
D GT55^PSIVORFB S OLDON=$P($G(^PS(55,DFN,"IV",+ON55,2)),"^",5),P("OLDON")=OLDON
N PSJPRIO,PSJSCH,NODE0,NODEP2 S NODE0=$G(^PS(55,DFN,"IV",+ON55,0)),NODEP2=$G(^PS(55,DFN,"IV",+ON55,.2))
S PSJPRIO=$P(NODEP2,"^",4),PSJSCH=$P(NODE0,"^",9)
I (",S,A,")[(","_$G(PSJPRIO)_",")!($G(PSJSCH)="NOW")!($G(PSJSCH)["STAT") D NOTIFY^PSJHL4(ON55,DFN,$G(PSJPRIO),$G(PSJSCH))
Q
PSJLIACT ;BIR/MV-IV ACTION ;29-May-2012 14:38;PLS
+1 ;;5.0; INPATIENT MEDICATIONS ;**15,47,62,58,82,97,80,1013,110,111,134,1015**;16 DEC 97;Build 62
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ; Reference to MAIN^TIUEDIT is supported by DBIA 2410.
+5 ;
+6 ; Modified - IHS/MSC/PLS - 10/17/2011 - Line DC+1
DC ; Discontinue order
+1 NEW INCOM
+2 DO HOLDHDR^PSJOE
+3 SET PSJCOM=+$SELECT(PSJORD["V":$PIECE($GET(^PS(55,DFN,"IV",+PSJORD,.2)),"^",8),1:$PIECE($GET(^PS(53.1,+PSJORD,.2)),"^",8))
+4 IF PSJCOM
WRITE !!,"This order is part of a complex order. If you discontinue this order the",!,"following orders will be discontinued too (unless the stop date has already",!,"been reached)."
DO CMPLX^PSJCOM1(PSGP,PSJCOM,PSJORD)
+5 IF PSJCOM
FOR
WRITE !!,"Do you want to discontinue this order"
SET %=1
DO YN^DICN
IF %
QUIT
DO ENCOM^PSGOEM
+6 IF PSJCOM
IF %'=1
SET VALMBK=""
QUIT
+7 IF PSJORD["V"
DO DC^PSIVORA
DO EN^PSJLIORD(DFN,ON)
QUIT
+8 IF PSJORD["P"
DO DISCONT^PSIVORC
+9 SET VALMBCK="Q"
+10 QUIT
ACEDIT ; Display LM screen and AC and EDit actions
+1 DO EN^PSJLIVMD
+2 SET VALMBCK=$SELECT($GET(PSIVACEP):"Q",1:"R")
+3 QUIT
AEEXIT ; Call for EXIT CODE in PSJ LM IV AC/EDIT
+1 IF ON["V"
DO GT55^PSIVORFB
+2 IF ON["P"
DO GT531^PSIVORFA(DFN,ON)
IF P("OT")'="I"
DO GTDATA^PSJLIFN
+3 DO EN^PSJLIVMD
+4 KILL PSIVENO
+5 QUIT
EDIT ; Edit order
+1 KILL PSIVFN1
NEW PSIVNBD
+2 IF $DATA(PSGACT)
IF PSGACT'["E"
WRITE !,"This order may not be edited."
DO PAUSE^VALM1
QUIT
+3 DO EDIT1
+4 IF $DATA(PSIVNBD)!($GET(PSIVCOPY)&'$GET(PSIVENO))
QUIT
+5 DO EN^PSJLIVMD
+6 SET VALMBCK=$SELECT($GET(PSIVFN1):"Q",1:"R")
+7 QUIT
EDIT1 ;
+1 ;Ensure P() is defined
+2 IF $DATA(P)<10
SET XQORQUIT=1
SET P("PON")=""
SET PSIVNBD=1
Begin DoDot:1
+3 WRITE !,"WARNING: An error has occurred. Changes will not be saved"
+4 DO PAUSE^VALM1
+5 SET VALMBCK="Q"
End DoDot:1
QUIT
+6 IF "ANP"'[P(17)
WRITE !,"You cannot edit an inactive order"
DO PAUSE^VALM1
QUIT
+7 IF $GET(ON55)=""
SET ON55=$GET(PSJORD)
+8 DO HOLDHDR^PSJOE
+9 ;* Edit a new back door order
+10 IF ($GET(ON55)["V"&($GET(P("21FLG"))=""))
Begin DoDot:1
+11 DO GSTRING^PSIVORE1
DO GTFLDS^PSIVORFE
+12 IF $GET(ON55)["V"
IF '$GET(DONE)
DO OK^PSIVORE
+13 SET VALMBCK="Q"
SET PSIVNBD=1
End DoDot:1
QUIT
+14 ;* Edit an active order
+15 IF $GET(ON55)["V"
NEW PSJEDIT1
DO E^PSIVOPT1
Begin DoDot:1
+16 IF $GET(PSJIVBD)
KILL PSJIVBD
DO EN^PSJLIORD(DFN,ON)
End DoDot:1
QUIT
+17 ;Edit incomplete order.
IF $GET(ON55)["P"
DO EDIT^PSIVORC
+18 KILL P("OVRIDE")
+19 QUIT
ACCEPT ; Accept order
+1 DO HOLDHDR^PSJOE
+2 ;Accept IV from back door.
+3 IF $GET(PSJIVBD)
KILL PSJIVBD
DO OK^PSIVORE
SET VALMBCK="Q"
QUIT
+4 IF ON["V"
DO ACCEPT^PSIVOPT1
QUIT
+5 SET PSIVFN1=1
+6 DO COMPLTE^PSIVORC1
+7 SET VALMBCK="Q"
+8 QUIT
R ; Renewal
+1 SET PSJREN=1
+2 DO HOLDHDR^PSJOE
+3 NEW PSIVAC
SET PSIVAC="PR"
KILL PSGFDX
+4 DO R^PSIVOPT
+5 DO EN^PSJLIORD(DFN,ON)
+6 KILL PSJREN
+7 QUIT
H ; Hold
+1 NEW TEX
SET TEX="Active order ***"
+2 DO HOLDHDR^PSJOE
+3 DO H^PSIVOPT(DFN,ON,P(17),P(3))
+4 IF P(17)="A"
DO PAUSE^VALM1
+5 DO EN^PSJLIORD(DFN,ON)
+6 QUIT
L ; Activity Log
+1 NEW PSIVLAB,PSIVLOG,PSJHIS
SET (PSIVLAB,PSIVLOG)=1
+2 DO EN^PSIVVW1
+3 DO EN^PSJLIVMD
+4 SET VALMBCK="R"
+5 QUIT
O ; On Call
+1 NEW TEX
SET TEX="Active order ***"
+2 DO HOLDHDR^PSJOE
+3 DO O^PSIVOPT(DFN,ON,P(17),P(3))
+4 IF P(17)="A"
DO PAUSE^VALM1
+5 DO EN^PSJLIORD(DFN,ON)
+6 QUIT
VF ; Make the order active
+1 NEW PSIVCHG
SET PSIVCHG=0
+2 IF ON["V"
SET ON55=ON
DO VF1("V","ORDER VERIFIED BY ",1)
QUIT
+3 DO ACTIVE^PSIVORC2
+4 QUIT
VF1(PSIVREA,PSIVAL,PSIVLOG) ;
+1 ;Update 4 node and set activity log.
+2 ;PSIVREA: the reason use by LOG^PSIVORAL
+3 ;PSIVAL : the description reason
+4 ;PSIVLOG: Log an activity if = 1
+5 IF '+$GET(OD)!($LENGTH($GET(OD))>16)
KILL OD
+6 IF +PSJSYSU=3
DO ^PSIVORE1
+7 NEW DIE,DA,DR,PSJX,XX,PSIVACT,PSJRQND
+8 SET PSIVACT=1
+9 SET PSJX=$GET(^PS(55,DFN,"IV",+ON55,4))
SET XX=""
+10 IF $PIECE(PSJX,U)=""
SET XX=";143////0"
+11 IF $PIECE(PSJX,U,4)=""
SET XX=XX_U_";142////0"
+12 DO NOW^%DTC
+13 SET DIE="^PS(55,"_DFN_",""IV"","
SET DA=+ON55
SET DA(1)=DFN
+14 IF +PSJSYSU=3
SET DR="140////"_DUZ_";141////"_$EXTRACT(%,1,12)_";142////1"_$PIECE(XX,U)
+15 IF +PSJSYSU=1
SET DR="16////"_DUZ_";17////"_$EXTRACT(%,1,12)_";143////1"_$PIECE(XX,U,2)
+16 IF $GET(P("PRY"))="D"
SET DR=DR_";.22////"_+P("IVRM")
+17 DO ^DIE
+18 ; If pending IV renew is edited during finish, go back and DE the original active order left in RENEWED status
+19 SET PREREN=$SELECT(ON55["V":$GET(@(DIE_"+ON55,2)")),1:"")
SET PREREN=$PIECE(PREREN,"^",5)
IF PREREN
Begin DoDot:1
+20 IF PREREN["P"
SET PREREN=$GET(@("^PS(53.1,+PREREN,0)"))
SET PREREN=$PIECE(PREREN,"^",25)
+21 IF PREREN["V"
NEW PRERENOD
SET PRERENOD=$GET(@("^PS(55,DFN,""IV"",+PREREN,0)"))
IF $PIECE(PRERENOD,"^",17)="R"
IF ($GET(P("RES"))="E")
Begin DoDot:2
+22 SET DIE="^PS(55,"_DFN_",""IV"","
SET DA=+PREREN
SET DA(1)=DFN
+23 SET DR="100////D;.03////"_PSGDT
SET ORIGSTOP=$PIECE($GET(@("^PS(55,DFN,""IV"",+PREREN,2)")),"^",3)
IF ORIGSTOP
SET DR=DR_";116////"_ORIGSTOP
+24 DO ^DIE
DO EN1^PSJHL2(DFN,"SC",PREREN)
End DoDot:2
End DoDot:1
KILL PREREN
+25 KILL DR,DIE,DA
+26 IF (+PSJSYSU=3)&($GET(P("PRY"))="D")
Begin DoDot:1
+27 NEW DIR
WRITE !
SET DIR(0)="S^Y:Yes;N:No"
SET DIR("A")="Do you want to enter a Progress Note"
SET DIR("B")="No"
DO ^DIR
+28 IF Y="N"
QUIT
+29 DO MAIN^TIUEDIT(3,.TIUDA,DFN,"","","","",1)
End DoDot:1
+30 IF '$GET(PSIVLOG)
QUIT
+31 IF $GET(P("PACT"))]""
IF +$PIECE(P("PACT"),U,2)
IF +$PIECE(P("PACT"),U,3)
Begin DoDot:1
+32 NEW DIC,DA,X,Y,XX,DO
DO NAME^PSJBCMA1($PIECE(P("PACT"),U,2),.XX)
+33 SET DIC(0)="L"
SET DA(1)=DFN
SET DA(2)=+ON55
SET X=1
+34 SET DIC="^PS(55,"_DA(1)_",""IV"","_DA(2)_",""A"","
+35 SET DIC("DR")=".02////F;.03////"_XX_";.04////"_$PIECE($GET(^PS(53.3,+$PIECE(P("PACT"),U,3),0)),U)_";.05////"_$PIECE(P("PACT"),U)_";.06////"_$PIECE(P("PACT"),U,2)
+36 DO FILE^DICN
End DoDot:1
+37 NEW PSIVALCK
+38 SET PSIVREA="V"
SET PSIVALT=""
+39 SET PSIVAL=PSIVAL_$SELECT(+PSJSYSU=3:"PHARMACIST",1:"NURSE")
+40 DO LOG^PSIVORAL
KILL PSIVAL,PSIVREA,PSIVLN
+41 IF $GET(PSJORD)["P"
SET PSIVREA="V"
SET PSIVALT=""
SET PSGRDTX=$GET(^PS(53.1,+PSJORD,2.5))
Begin DoDot:1
+42 IF $GET(PSGRDTX)
SET PSIVAL="Requested Start Date: "_$$ENDTC^PSGMI($$DATE2^PSJUTL2($PIECE(PSGRDTX,U)))
DO LOG^PSIVORAL
+43 IF $PIECE(PSGRDTX,U,3)
SET PSIVREA="V"
SET PSIVALT=""
SET PSIVAL="Requested Stop Date: "_$$ENDTC^PSGMI($$DATE2^PSJUTL2($PIECE(PSGRDTX,U,3)))
DO LOG^PSIVORAL
End DoDot:1
+44 NEW DUR
IF $GET(PSJORD)
SET DUR=$$GETDUR^PSJLIVMD(DFN,+PSJORD,$SELECT(PSJORD["P":"P",1:"IV"),1)
IF DUR]""
Begin DoDot:1
+45 KILL DR
SET DIE="^PS(55,"_DFN_",""IV"","
SET DA=+ON55
SET DA(1)=DFN
+46 SET DR=$SELECT($GET(IVLIMIT):"152////"_DUR,1:"151////"_DUR)
KILL IVLIMIT
+47 DO ^DIE
End DoDot:1
+48 DO EN1^PSJHL2(DFN,"SC",ON55)
+49 IF +PSJSYSU=1
DO EN1^PSJHL2(DFN,"ZV",ON55)
+50 DO GT55^PSIVORFB
SET OLDON=$PIECE($GET(^PS(55,DFN,"IV",+ON55,2)),"^",5)
SET P("OLDON")=OLDON
+51 NEW PSJPRIO,PSJSCH,NODE0,NODEP2
SET NODE0=$GET(^PS(55,DFN,"IV",+ON55,0))
SET NODEP2=$GET(^PS(55,DFN,"IV",+ON55,.2))
+52 SET PSJPRIO=$PIECE(NODEP2,"^",4)
SET PSJSCH=$PIECE(NODE0,"^",9)
+53 IF (",S,A,")[(","_$GET(PSJPRIO)_",")!($GET(PSJSCH)="NOW")!($GET(PSJSCH)["STAT")
DO NOTIFY^PSJHL4(ON55,DFN,$GET(PSJPRIO),$GET(PSJSCH))
+54 QUIT
