PSJLIACT ;BIR/MV - IV ACTION ;28 Jul 98 8:50 AM
;;5.0;INPATIENT MEDICATIONS;**15,47,62,58,82,97,80,110,111,134,181,247,260,275,257,299,281,346,256,347,344**;16 DEC 97;Build 7
;
; Reference to ^PS(55 is supported by DBIA 2191.
; Reference to MAIN^TIUEDIT is supported by DBIA 2410.
; Reference to ^TMP("PSODAOC",$J supported by DBIA 6071.
;
DC ; Discontinue order
K PSGORQF
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 $G(ON55)["P",$G(PSIVOORD) S PSJORD=ON55 ;*247 - Correct DCing newly copied orders
I PSJORD["V" D DC^PSIVORA D:'$G(PSJOCFLG) EN^PSJLIORD(DFN,ON) Q
I PSJORD["P" N ON S ON=PSJORD D 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
I ON["V" K PSGORQF D GT55^PSIVORFB ;RTC 340818
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
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")
;S PSJEDFLG=1 ;PSJ*346 Prevent double order display
I $G(PSGORQF) S VALMBCK="Q" K PSIVENO,PSJOCCHK ;RTC 340818
Q
EDIT1 ;
K PSGORQF ;RTC 340818
;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
N PSIEDITO S PSIEDITO=1
;* 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(PSGORQF) K PSIVENO,PSJOCCHK ;RTC 340818
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
;D:'$G(PSGORQF) IN^PSJOCDS($G(ON),"IV","") Q:$G(PSGORQF)
I ON["V" D ACCEPT^PSIVOPT1 S:'$G(PSGORQF) PSJDSVFY=1 Q
S PSIVFN1=1
D COMPLTE^PSIVORC1
K ^TMP("PSODAOC",$J)
S VALMBCK="Q"
Q
R ; Renewal
K PSGORQF,PSJOCCHK,PSIVENO
S PSJREN=1
D HOLDHDR^PSJOE
NEW PSIVAC,PSJOLDNM S PSIVAC="PR" K PSGFDX
S PSJOLDNM("ORD_SCHD")=$P($G(^PS(55,DFN,"IV",+ON,0)),U,9)
I PSJOLDNM("ORD_SCHD")]"",$$CHKSCHD^PSJMISC2(.PSJOLDNM,"R") K PSJOLDNM Q
K PSJOLDNM
D R^PSIVOPT
D EN^PSJLIORD(DFN,ON)
K PSJREN,^TMP("PSODAOC",$J)
Q
H ; Hold
K PSGORQF
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
K PSGORQF
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 **ENHANCEMENTS MADE IN PSJ*5.0*260
NEW PSIVCHG,PSGORQF,PSJVFF,PSJOLDNM S PSIVCHG=0
;PSJ*5*256 - inform user of old schedule name and quit
I $S((ON["P"):$P($G(^PS(53.1,+ON,0)),U,24)'="R",(ON["V"):$P($G(^PS(55,+PSGP,"IV",+ON,2)),U,8)'="R",1:0) D Q:$G(PSGORQF)
.D FULL^VALM1
.S PSJOLDNM("ORD_SCHD")=$G(PSGSCH)
.S PSGORQF=$$CHKSCHD^PSJMISC2(.PSJOLDNM,"V")
;IF VALM("TITLE")="ACTIVE IV " W !!,">>> Verify may not be selected at this point." D PAUSE^VALM1 S VALMBCK="R" Q ;PSJ*5*281 CCR 6995 Remedy ticket 861870
;ELSE IF $G(PSGSTAT)="NON-VERIFIED",$G(PSJNEWOE)=0 S PSJVFF=1 D EN^PSJGMRA($G(DFN),$G(PSGPD)),IN^PSJOCDS($G(PSGORD),"IV",""),OC^PSIVOC K PSJVFF Q:$G(PSGORQF)
;PSGSTAT may not set for IV orders. Checking PSJOCFG so DI,DT is not displayed again for FN, CO, RN...
IF (($G(PSGSTAT)="NON-VERIFIED")!($G(P(17))="N")&($G(PSJOCFG)="")),'+$G(PSJNEWOE) D
.S PSJVFF=1 D:'$G(PSJENHOC)&'$G(PSGORQF) OC^PSIVOC D:('$G(PSGORQF)&'$G(PSJDSVFY)) IN^PSJOCDS($G(PSGORD),"IV","") K PSJVFF Q:$G(PSGORQF)
Q:$G(PSGORQF)
ELSE IF '$G(PSGORQF),(ON["V") S ON55=ON D VF1("V","ORDER VERIFIED BY ",1) Q
ELSE IF $G(PSIVFN1),(ON["V") S ON55=ON D VF1("V","ORDER VERIFIED BY ",1) Q
ELSE IF $G(PSGDEF),(ON["V") S ON55=ON D VF1("V","ORDER VERIFIED BY ",1) Q
ELSE IF $G(PSIVCOPY),(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
K PSGORQF
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
S ^TMP("PSODAOC",$J,"IP NEW IEN")=ON55
D EN1^PSJHL2(DFN,"SC",ON55),SETOC^PSJNEWOC(ON55)
D:+PSJSYSU=1 EN1^PSJHL2(DFN,"ZV",ON55)
I '$D(^PS(55,DFN,"IV","CIMOI",+ON55)) D CIMOI^PSJIMO1(DFN,ON55,"",$G(PSJORD))
E I +$G(PSJORD) D KILL531^PSJIMO1(DFN,"",PSJORD)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJLIACT 8339 printed Oct 16, 2024@18:08:04 Page 2
PSJLIACT ;BIR/MV - IV ACTION ;28 Jul 98 8:50 AM
+1 ;;5.0;INPATIENT MEDICATIONS;**15,47,62,58,82,97,80,110,111,134,181,247,260,275,257,299,281,346,256,347,344**;16 DEC 97;Build 7
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ; Reference to MAIN^TIUEDIT is supported by DBIA 2410.
+5 ; Reference to ^TMP("PSODAOC",$J supported by DBIA 6071.
+6 ;
DC ; Discontinue order
+1 KILL PSGORQF
+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 ;*247 - Correct DCing newly copied orders
IF $GET(ON55)["P"
IF $GET(PSIVOORD)
SET PSJORD=ON55
+8 IF PSJORD["V"
DO DC^PSIVORA
if '$GET(PSJOCFLG)
DO EN^PSJLIORD(DFN,ON)
QUIT
+9 IF PSJORD["P"
NEW ON
SET ON=PSJORD
DO DISCONT^PSIVORC
+10 SET VALMBCK="Q"
+11 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 ;RTC 340818
IF ON["V"
KILL PSGORQF
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
+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 ;S PSJEDFLG=1 ;PSJ*346 Prevent double order display
+8 ;RTC 340818
IF $GET(PSGORQF)
SET VALMBCK="Q"
KILL PSIVENO,PSJOCCHK
+9 QUIT
EDIT1 ;
+1 ;RTC 340818
KILL PSGORQF
+2 ;Ensure P() is defined
+3 IF $DATA(P)<10
SET XQORQUIT=1
SET P("PON")=""
SET PSIVNBD=1
Begin DoDot:1
+4 WRITE !,"WARNING: An error has occurred. Changes will not be saved"
+5 DO PAUSE^VALM1
+6 SET VALMBCK="Q"
End DoDot:1
QUIT
+7 IF "ANP"'[P(17)
WRITE !,"You cannot edit an inactive order"
DO PAUSE^VALM1
QUIT
+8 if $GET(ON55)=""
SET ON55=$GET(PSJORD)
+9 DO HOLDHDR^PSJOE
+10 NEW PSIEDITO
SET PSIEDITO=1
+11 ;* Edit a new back door order
+12 IF ($GET(ON55)["V"&($GET(P("21FLG"))=""))
Begin DoDot:1
+13 DO GSTRING^PSIVORE1
DO GTFLDS^PSIVORFE
+14 IF $GET(ON55)["V"
IF '$GET(DONE)
DO OK^PSIVORE
+15 SET VALMBCK="Q"
SET PSIVNBD=1
End DoDot:1
QUIT
+16 ;* Edit an active order
+17 IF $GET(ON55)["V"
NEW PSJEDIT1
DO E^PSIVOPT1
Begin DoDot:1
+18 IF $GET(PSJIVBD)
KILL PSJIVBD
DO EN^PSJLIORD(DFN,ON)
+19 ;RTC 340818
IF $GET(PSGORQF)
KILL PSIVENO,PSJOCCHK
End DoDot:1
QUIT
+20 ;Edit incomplete order.
IF $GET(ON55)["P"
DO EDIT^PSIVORC
+21 KILL P("OVRIDE")
+22 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 ;D:'$G(PSGORQF) IN^PSJOCDS($G(ON),"IV","") Q:$G(PSGORQF)
+5 IF ON["V"
DO ACCEPT^PSIVOPT1
if '$GET(PSGORQF)
SET PSJDSVFY=1
QUIT
+6 SET PSIVFN1=1
+7 DO COMPLTE^PSIVORC1
+8 KILL ^TMP("PSODAOC",$JOB)
+9 SET VALMBCK="Q"
+10 QUIT
R ; Renewal
+1 KILL PSGORQF,PSJOCCHK,PSIVENO
+2 SET PSJREN=1
+3 DO HOLDHDR^PSJOE
+4 NEW PSIVAC,PSJOLDNM
SET PSIVAC="PR"
KILL PSGFDX
+5 SET PSJOLDNM("ORD_SCHD")=$PIECE($GET(^PS(55,DFN,"IV",+ON,0)),U,9)
+6 IF PSJOLDNM("ORD_SCHD")]""
IF $$CHKSCHD^PSJMISC2(.PSJOLDNM,"R")
KILL PSJOLDNM
QUIT
+7 KILL PSJOLDNM
+8 DO R^PSIVOPT
+9 DO EN^PSJLIORD(DFN,ON)
+10 KILL PSJREN,^TMP("PSODAOC",$JOB)
+11 QUIT
H ; Hold
+1 KILL PSGORQF
+2 NEW TEX
SET TEX="Active order ***"
+3 DO HOLDHDR^PSJOE
+4 DO H^PSIVOPT(DFN,ON,P(17),P(3))
+5 if P(17)="A"
DO PAUSE^VALM1
+6 DO EN^PSJLIORD(DFN,ON)
+7 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 KILL PSGORQF
+2 NEW TEX
SET TEX="Active order ***"
+3 DO HOLDHDR^PSJOE
+4 DO O^PSIVOPT(DFN,ON,P(17),P(3))
+5 if P(17)="A"
DO PAUSE^VALM1
+6 DO EN^PSJLIORD(DFN,ON)
+7 QUIT
VF ; Make the order active **ENHANCEMENTS MADE IN PSJ*5.0*260
+1 NEW PSIVCHG,PSGORQF,PSJVFF,PSJOLDNM
SET PSIVCHG=0
+2 ;PSJ*5*256 - inform user of old schedule name and quit
+3 IF $SELECT((ON["P"):$PIECE($GET(^PS(53.1,+ON,0)),U,24)'="R",(ON["V"):$PIECE($GET(^PS(55,+PSGP,"IV",+ON,2)),U,8)'="R",1:0)
Begin DoDot:1
+4 DO FULL^VALM1
+5 SET PSJOLDNM("ORD_SCHD")=$GET(PSGSCH)
+6 SET PSGORQF=$$CHKSCHD^PSJMISC2(.PSJOLDNM,"V")
End DoDot:1
if $GET(PSGORQF)
QUIT
+7 ;IF VALM("TITLE")="ACTIVE IV " W !!,">>> Verify may not be selected at this point." D PAUSE^VALM1 S VALMBCK="R" Q ;PSJ*5*281 CCR 6995 Remedy ticket 861870
+8 ;ELSE IF $G(PSGSTAT)="NON-VERIFIED",$G(PSJNEWOE)=0 S PSJVFF=1 D EN^PSJGMRA($G(DFN),$G(PSGPD)),IN^PSJOCDS($G(PSGORD),"IV",""),OC^PSIVOC K PSJVFF Q:$G(PSGORQF)
+9 ;PSGSTAT may not set for IV orders. Checking PSJOCFG so DI,DT is not displayed again for FN, CO, RN...
+10 IF (($GET(PSGSTAT)="NON-VERIFIED")!($GET(P(17))="N")&($GET(PSJOCFG)=""))
IF '+$GET(PSJNEWOE)
Begin DoDot:1
+11 SET PSJVFF=1
if '$GET(PSJENHOC)&'$GET(PSGORQF)
DO OC^PSIVOC
if ('$GET(PSGORQF)&'$GET(PSJDSVFY))
DO IN^PSJOCDS($GET(PSGORD),"IV","")
KILL PSJVFF
if $GET(PSGORQF)
QUIT
End DoDot:1
+12 if $GET(PSGORQF)
QUIT
+13 IF '$TEST
IF '$GET(PSGORQF)
IF (ON["V")
SET ON55=ON
DO VF1("V","ORDER VERIFIED BY ",1)
QUIT
+14 IF '$TEST
IF $GET(PSIVFN1)
IF (ON["V")
SET ON55=ON
DO VF1("V","ORDER VERIFIED BY ",1)
QUIT
+15 IF '$TEST
IF $GET(PSGDEF)
IF (ON["V")
SET ON55=ON
DO VF1("V","ORDER VERIFIED BY ",1)
QUIT
+16 IF '$TEST
IF $GET(PSIVCOPY)
IF (ON["V")
SET ON55=ON
DO VF1("V","ORDER VERIFIED BY ",1)
QUIT
+17 DO ACTIVE^PSIVORC2
+18 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 KILL PSGORQF
+6 IF '+$GET(OD)!($LENGTH($GET(OD))>16)
KILL OD
+7 if +PSJSYSU=3
DO ^PSIVORE1
+8 NEW DIE,DA,DR,PSJX,XX,PSIVACT,PSJRQND
+9 SET PSIVACT=1
+10 SET PSJX=$GET(^PS(55,DFN,"IV",+ON55,4))
SET XX=""
+11 IF $PIECE(PSJX,U)=""
SET XX=";143////0"
+12 IF $PIECE(PSJX,U,4)=""
SET XX=XX_U_";142////0"
+13 DO NOW^%DTC
+14 SET DIE="^PS(55,"_DFN_",""IV"","
SET DA=+ON55
SET DA(1)=DFN
+15 IF +PSJSYSU=3
SET DR="140////"_DUZ_";141////"_$EXTRACT(%,1,12)_";142////1"_$PIECE(XX,U)
+16 IF +PSJSYSU=1
SET DR="16////"_DUZ_";17////"_$EXTRACT(%,1,12)_";143////1"_$PIECE(XX,U,2)
+17 IF $GET(P("PRY"))="D"
SET DR=DR_";.22////"_+P("IVRM")
+18 DO ^DIE
+19 ; If pending IV renew is edited during finish, go back and DE the original active order left in RENEWED status
+20 SET PREREN=$SELECT(ON55["V":$GET(@(DIE_"+ON55,2)")),1:"")
SET PREREN=$PIECE(PREREN,"^",5)
IF PREREN
Begin DoDot:1
+21 IF PREREN["P"
SET PREREN=$GET(@("^PS(53.1,+PREREN,0)"))
SET PREREN=$PIECE(PREREN,"^",25)
+22 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
+23 SET DIE="^PS(55,"_DFN_",""IV"","
SET DA=+PREREN
SET DA(1)=DFN
+24 SET DR="100////D;.03////"_PSGDT
SET ORIGSTOP=$PIECE($GET(@("^PS(55,DFN,""IV"",+PREREN,2)")),"^",3)
IF ORIGSTOP
SET DR=DR_";116////"_ORIGSTOP
+25 DO ^DIE
DO EN1^PSJHL2(DFN,"SC",PREREN)
End DoDot:2
End DoDot:1
KILL PREREN
+26 KILL DR,DIE,DA
+27 IF (+PSJSYSU=3)&($GET(P("PRY"))="D")
Begin DoDot:1
+28 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
+29 if Y="N"
QUIT
+30 DO MAIN^TIUEDIT(3,.TIUDA,DFN,"","","","",1)
End DoDot:1
+31 if '$GET(PSIVLOG)
QUIT
+32 IF $GET(P("PACT"))]""
IF +$PIECE(P("PACT"),U,2)
IF +$PIECE(P("PACT"),U,3)
Begin DoDot:1
+33 NEW DIC,DA,X,Y,XX,DO
DO NAME^PSJBCMA1($PIECE(P("PACT"),U,2),.XX)
+34 SET DIC(0)="L"
SET DA(1)=DFN
SET DA(2)=+ON55
SET X=1
+35 SET DIC="^PS(55,"_DA(1)_",""IV"","_DA(2)_",""A"","
+36 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)
+37 DO FILE^DICN
End DoDot:1
+38 NEW PSIVALCK
+39 SET PSIVREA="V"
SET PSIVALT=""
+40 SET PSIVAL=PSIVAL_$SELECT(+PSJSYSU=3:"PHARMACIST",1:"NURSE")
+41 DO LOG^PSIVORAL
KILL PSIVAL,PSIVREA,PSIVLN
+42 IF $GET(PSJORD)["P"
SET PSIVREA="V"
SET PSIVALT=""
SET PSGRDTX=$GET(^PS(53.1,+PSJORD,2.5))
Begin DoDot:1
+43 IF $GET(PSGRDTX)
SET PSIVAL="Requested Start Date: "_$$ENDTC^PSGMI($$DATE2^PSJUTL2($PIECE(PSGRDTX,U)))
DO LOG^PSIVORAL
+44 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
+45 NEW DUR
IF $GET(PSJORD)
SET DUR=$$GETDUR^PSJLIVMD(DFN,+PSJORD,$SELECT(PSJORD["P":"P",1:"IV"),1)
IF DUR]""
Begin DoDot:1
+46 KILL DR
SET DIE="^PS(55,"_DFN_",""IV"","
SET DA=+ON55
SET DA(1)=DFN
+47 SET DR=$SELECT($GET(IVLIMIT):"152////"_DUR,1:"151////"_DUR)
KILL IVLIMIT
+48 DO ^DIE
End DoDot:1
+49 SET ^TMP("PSODAOC",$JOB,"IP NEW IEN")=ON55
+50 DO EN1^PSJHL2(DFN,"SC",ON55)
DO SETOC^PSJNEWOC(ON55)
+51 if +PSJSYSU=1
DO EN1^PSJHL2(DFN,"ZV",ON55)
+52 IF '$DATA(^PS(55,DFN,"IV","CIMOI",+ON55))
DO CIMOI^PSJIMO1(DFN,ON55,"",$GET(PSJORD))
+53 IF '$TEST
IF +$GET(PSJORD)
DO KILL531^PSJIMO1(DFN,"",PSJORD)
+54 DO GT55^PSIVORFB
SET OLDON=$PIECE($GET(^PS(55,DFN,"IV",+ON55,2)),"^",5)
SET P("OLDON")=OLDON
+55 NEW PSJPRIO,PSJSCH,NODE0,NODEP2
SET NODE0=$GET(^PS(55,DFN,"IV",+ON55,0))
SET NODEP2=$GET(^PS(55,DFN,"IV",+ON55,.2))
+56 SET PSJPRIO=$PIECE(NODEP2,"^",4)
SET PSJSCH=$PIECE(NODE0,"^",9)
+57 IF (",S,A,")[(","_$GET(PSJPRIO)_",")!($GET(PSJSCH)="NOW")!($GET(PSJSCH)["STAT")
DO NOTIFY^PSJHL4(ON55,DFN,$GET(PSJPRIO),$GET(PSJSCH))
+58 QUIT
