Summary Table

Categories	Total Count
PII	0
URL	0
DNS	0
EKL	0
IP	0
PORT	0
VsID	0
CF	0
AI	0
VPD	0
PL	0
Other	0

File Content

Packman Mail Message:
=====================

$END TXT
$KID PSJ*5.0*373
**INSTALL NAME**
PSJ*5.0*373
"BLD",10446,0)
PSJ*5.0*373^INPATIENT MEDICATIONS^0^3180716^y
"BLD",10446,4,0)
^9.64PA^^
"BLD",10446,6.3)
3
"BLD",10446,"ABPKG")
n
"BLD",10446,"KRN",0)
^9.67PA^779.2^20
"BLD",10446,"KRN",.4,0)
.4
"BLD",10446,"KRN",.401,0)
.401
"BLD",10446,"KRN",.402,0)
.402
"BLD",10446,"KRN",.403,0)
.403
"BLD",10446,"KRN",.5,0)
.5
"BLD",10446,"KRN",.84,0)
.84
"BLD",10446,"KRN",3.6,0)
3.6
"BLD",10446,"KRN",3.8,0)
3.8
"BLD",10446,"KRN",9.2,0)
9.2
"BLD",10446,"KRN",9.8,0)
9.8
"BLD",10446,"KRN",9.8,"NM",0)
^9.68A^22^22
"BLD",10446,"KRN",9.8,"NM",1,0)
PSGO^^0^B41234695
"BLD",10446,"KRN",9.8,"NM",2,0)
PSGOE41^^0^B102492308
"BLD",10446,"KRN",9.8,"NM",3,0)
PSGOE81^^0^B115959656
"BLD",10446,"KRN",9.8,"NM",4,0)
PSGOE91^^0^B121528275
"BLD",10446,"KRN",9.8,"NM",5,0)
PSGOEE^^0^B107177603
"BLD",10446,"KRN",9.8,"NM",6,0)
PSGOEEW^^0^B29287658
"BLD",10446,"KRN",9.8,"NM",7,0)
PSGOEF^^0^B126624363
"BLD",10446,"KRN",9.8,"NM",8,0)
PSGVW^^0^B33609495
"BLD",10446,"KRN",9.8,"NM",9,0)
PSIVACT^^0^B31395934
"BLD",10446,"KRN",9.8,"NM",10,0)
PSIVEDT1^^0^B119441864
"BLD",10446,"KRN",9.8,"NM",11,0)
PSIVPRO^^0^B51389266
"BLD",10446,"KRN",9.8,"NM",12,0)
PSIVUTL^^0^B45543984
"BLD",10446,"KRN",9.8,"NM",13,0)
PSJLIUTL^^0^B58538062
"BLD",10446,"KRN",9.8,"NM",14,0)
PSJLIVFD^^0^B65805635
"BLD",10446,"KRN",9.8,"NM",15,0)
PSJLIVMD^^0^B103647845
"BLD",10446,"KRN",9.8,"NM",16,0)
PSJLMGUD^^0^B31955674
"BLD",10446,"KRN",9.8,"NM",17,0)
PSJLMPRI^^0^B24538481
"BLD",10446,"KRN",9.8,"NM",18,0)
PSJLMPRU^^0^B25811546
"BLD",10446,"KRN",9.8,"NM",19,0)
PSJLMUDE^^0^B97320744
"BLD",10446,"KRN",9.8,"NM",20,0)
PSJLMUT1^^0^B76113417
"BLD",10446,"KRN",9.8,"NM",21,0)
PSJO^^0^B38311282
"BLD",10446,"KRN",9.8,"NM",22,0)
PSJOE1^^0^B32599287
"BLD",10446,"KRN",9.8,"NM","B","PSGO",1)

"BLD",10446,"KRN",9.8,"NM","B","PSGOE41",2)

"BLD",10446,"KRN",9.8,"NM","B","PSGOE81",3)

"BLD",10446,"KRN",9.8,"NM","B","PSGOE91",4)

"BLD",10446,"KRN",9.8,"NM","B","PSGOEE",5)

"BLD",10446,"KRN",9.8,"NM","B","PSGOEEW",6)

"BLD",10446,"KRN",9.8,"NM","B","PSGOEF",7)

"BLD",10446,"KRN",9.8,"NM","B","PSGVW",8)

"BLD",10446,"KRN",9.8,"NM","B","PSIVACT",9)

"BLD",10446,"KRN",9.8,"NM","B","PSIVEDT1",10)

"BLD",10446,"KRN",9.8,"NM","B","PSIVPRO",11)

"BLD",10446,"KRN",9.8,"NM","B","PSIVUTL",12)

"BLD",10446,"KRN",9.8,"NM","B","PSJLIUTL",13)

"BLD",10446,"KRN",9.8,"NM","B","PSJLIVFD",14)

"BLD",10446,"KRN",9.8,"NM","B","PSJLIVMD",15)

"BLD",10446,"KRN",9.8,"NM","B","PSJLMGUD",16)

"BLD",10446,"KRN",9.8,"NM","B","PSJLMPRI",17)

"BLD",10446,"KRN",9.8,"NM","B","PSJLMPRU",18)

"BLD",10446,"KRN",9.8,"NM","B","PSJLMUDE",19)

"BLD",10446,"KRN",9.8,"NM","B","PSJLMUT1",20)

"BLD",10446,"KRN",9.8,"NM","B","PSJO",21)

"BLD",10446,"KRN",9.8,"NM","B","PSJOE1",22)

"BLD",10446,"KRN",19,0)
19
"BLD",10446,"KRN",19.1,0)
19.1
"BLD",10446,"KRN",101,0)
101
"BLD",10446,"KRN",409.61,0)
409.61
"BLD",10446,"KRN",771,0)
771
"BLD",10446,"KRN",779.2,0)
779.2
"BLD",10446,"KRN",870,0)
870
"BLD",10446,"KRN",8989.51,0)
8989.51
"BLD",10446,"KRN",8989.52,0)
8989.52
"BLD",10446,"KRN",8994,0)
8994
"BLD",10446,"KRN","B",.4,.4)

"BLD",10446,"KRN","B",.401,.401)

"BLD",10446,"KRN","B",.402,.402)

"BLD",10446,"KRN","B",.403,.403)

"BLD",10446,"KRN","B",.5,.5)

"BLD",10446,"KRN","B",.84,.84)

"BLD",10446,"KRN","B",3.6,3.6)

"BLD",10446,"KRN","B",3.8,3.8)

"BLD",10446,"KRN","B",9.2,9.2)

"BLD",10446,"KRN","B",9.8,9.8)

"BLD",10446,"KRN","B",19,19)

"BLD",10446,"KRN","B",19.1,19.1)

"BLD",10446,"KRN","B",101,101)

"BLD",10446,"KRN","B",409.61,409.61)

"BLD",10446,"KRN","B",771,771)

"BLD",10446,"KRN","B",779.2,779.2)

"BLD",10446,"KRN","B",870,870)

"BLD",10446,"KRN","B",8989.51,8989.51)

"BLD",10446,"KRN","B",8989.52,8989.52)

"BLD",10446,"KRN","B",8994,8994)

"BLD",10446,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",10446,"QUES",0)
^9.62^^
"BLD",10446,"REQB",0)
^9.611^6^6
"BLD",10446,"REQB",1,0)
PSJ*5.0*194^2
"BLD",10446,"REQB",2,0)
PSJ*5.0*256^2
"BLD",10446,"REQB",3,0)
PSJ*5.0*304^2
"BLD",10446,"REQB",4,0)
PSJ*5.0*329^2
"BLD",10446,"REQB",5,0)
PSJ*5.0*334^2
"BLD",10446,"REQB",6,0)
PSJ*5.0*338^2
"BLD",10446,"REQB","B","PSJ*5.0*194",1)

"BLD",10446,"REQB","B","PSJ*5.0*256",2)

"BLD",10446,"REQB","B","PSJ*5.0*304",3)

"BLD",10446,"REQB","B","PSJ*5.0*329",4)

"BLD",10446,"REQB","B","PSJ*5.0*334",5)

"BLD",10446,"REQB","B","PSJ*5.0*338",6)

"MBREQ")
0
"PKG",197,-1)
1^1
"PKG",197,0)
INPATIENT MEDICATIONS^PSJ^UNIT DOSE AND IVS
"PKG",197,20,0)
^9.402P^^
"PKG",197,22,0)
^9.49I^1^1
"PKG",197,22,1,0)
5.0^2971215^2980917^11712
"PKG",197,22,1,"PAH",1,0)
373^3180716
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
22
"RTN","PSGO")
0^1^B41234695^B39627205
"RTN","PSGO",1,0)
PSGO ;BIR/CML3,MV - PRINTS PATIENT'S ORDERS ;Jul 12, 2018@13:10
"RTN","PSGO",2,0)
;;5.0;INPATIENT MEDICATIONS;**4,58,110,181,275,373**;16 DEC 97;Build 3
"RTN","PSGO",3,0)
;
"RTN","PSGO",4,0)
; Reference to ^PS(55 is supported by DBIA #2191.
"RTN","PSGO",5,0)
;
"RTN","PSGO",6,0)
K ^TMP("PSJON",$J),PSGONF S PSGOH="U N I T D O S E P R O F I L E" D ENGORD^PSGOU
"RTN","PSGO",7,0)
;
"RTN","PSGO",8,0)
EN ;
"RTN","PSGO",9,0)
N TF2 S TF2=""
"RTN","PSGO",10,0)
S CML=IO'=IO(0)!($E(IOST,1,2)'="C-"),NP="" N RB
"RTN","PSGO",11,0)
U IO D GET I '$D(^TMP("PSG",$J)) W !,SLS,SLS,$E(SLS,1,24),!?22,"NO ORDERS FOUND" W:"SL"[PSGOL "
FOR A ",$S(PSGOL="S":"SHORT",1:"LONG")," PROFILE."
"RTN","PSGO",12,0)
G:NP["^" DONE
"RTN","PSGO",13,0)
E S (C,DRG)="",LD=0
"RTN","PSGO",14,0)
E D DRG G:NP["^" DONE
"RTN","PSGO",15,0)
I CML,$S('$D(PSGPRP):1,1:PSGPRP="P") D BOT
"RTN","PSGO",16,0)
;
"RTN","PSGO",17,0)
DONE ;
"RTN","PSGO",18,0)
I $S('$D(PSGPRP):1,1:PSGPRP="P") K ^TMP("PSG",$J)
"RTN","PSGO",19,0)
S PSGON=$S('CML:ON,1:0) K:'$D(PSGVBW) PSGODT
"RTN","PSGO",20,0)
;
"RTN","PSGO",21,0)
D1 ;
"RTN","PSGO",22,0)
K
C,CML,DN,DO,DRG,F,GIVE,HDT,LN2,NF,ND,ND4,ND6,NP,O,ON,PF,PG,PSGHD,PSGOH,PSJTEAM,RCT,RF,RT
E,S,SCH,SD,SLS,SM,ST,STS,TF,UDU,V,WD,WS,WT Q
"RTN","PSGO",23,0)
;
"RTN","PSGO",24,0)
DRG ;
"RTN","PSGO",25,0)
I PSGOL'="N" F S C=$O(^TMP("PSG",$J,C)) Q:C=""!(NP["^")
D:$S(($P(C,"^")="Cz")&(TF2'=$P(C,"^",2)):1,C="BA":1,C="CC":1,C="CD":1,C["C":TF,1:1) TF F
ST="C","O","OC","P","R","z" D
"RTN","PSGO",26,0)
.F S DRG=$O(^TMP("PSG",$J,C,ST,DRG)) Q:DRG=""!(NP["^") S
NF=^(DRG),O=$P(DRG,"^",2),DN=$P(DRG,"^") D:$Y+4>IOSL NP Q:NP["^" D P
"RTN","PSGO",27,0)
I PSGOL="N" F S LD=$O(^TMP("PSG",$J,LD)) Q:'LD S
X=^(LD),NF=$P(X,U),C=$P(X,U,2),ST=$P(X,U,3),DN=$P(X,U,4),O=$P(LD,U,2) D P
"RTN","PSGO",28,0)
Q
"RTN","PSGO",29,0)
;
"RTN","PSGO",30,0)
P ;Display drug data stored in ^TMP("PSG",$J
"RTN","PSGO",31,0)
I $G(O)["U"&($P(C,"^",4)="A") N F S F="^PS(55,PSGP,5,"
"RTN","PSGO",32,0)
S ON=ON+1 I 'CML D
"RTN","PSGO",33,0)
.N PSJOSUFX I ($P(C,"^")="Cz") S
PSJOSUFX=$S(($P(C,"^",4))["CD":"",($P(C,"^",4)["C"):"P",($P(C,"^",4)["BD"):"",($P(C,"^",4)["B"):"P",1:"U"
)
"RTN","PSGO",34,0)
.I ($P(C,"^")'="Cz") S PSJOSUFX=$S(C["CD":"",C["C":"P",C["BD":"",C["B":"P",1:"U")
"RTN","PSGO",35,0)
.S ^TMP("PSJON",$J,ON)=+O_PSJOSUFX
"RTN","PSGO",36,0)
.S:(C'["O"&($P(C,"^")'="Cz")) PSGONC=ON S:($P(C,"^")="Cz"&($P(C,"^",4)'["O")) PSGONC=ON
"RTN","PSGO",37,0)
Q:PSGOL="N"
"RTN","PSGO",38,0)
W !,$J(ON,4),?5
"RTN","PSGO",39,0)
I (C["CD"&($P(C,"^")'="Cz"))!($P(C,"^",4)["CD") N PSJO,OO S PSJO=O,OO=0 F S
OO=$O(^PS(53.1,"ACX",PSJO,OO)) Q:'OO S O=OO D P2 W !
"RTN","PSGO",40,0)
I (C["BD"&($P(C,"^")'="Cz"))!($P(C,"^",4)["BD") N PSJO,OO S PSJO=O,OO=0 F S
OO=$O(^PS(53.1,"ACX",PSJO,OO)) Q:'OO S O=OO D P2 W !
"RTN","PSGO",41,0)
Q:(C["BD"&($P(C,"^")'="Cz")) Q:(C["CD"&($P(C,"^")'="Cz")) Q:($P(C,"^",4)["BD") Q:($P(C,"^",4)["CD")
"RTN","PSGO",42,0)
; naked references below refer to full reference inside indirection @(F_+O_".0)" for either file 53.1 or 55
"RTN","PSGO",43,0)
P2 S ND=$G(@(F_+O_",0)")),SCH=$G(^(2)),ND4=$G(^(4)),ND6=$G(^(6)),DO=$G(^(.2))
"RTN","PSGO",44,0)
I (C="A"!($P(C,"^",4)="A")),PSJSYSU,'$P(ND4,"^",+PSJSYSU),$P(ND4,"^",+PSJSYSU=1+9) S PSGONV=ON
"RTN","PSGO",45,0)
I (C="A"!(C="O"))!(($P(C,"^",4)="A")!($P(C,"^",4)="O")) S:$P(ND,"^",9)'="H"&'CML PSGONR=ON D
"RTN","PSGO",46,0)
.S V='$P(ND4,"^",UDU),V=$S(+PSJSYSU=1&V:1,+PSJSYSU=3&V:1,1:0)
"RTN","PSGO",47,0)
.W $S(ND4="":"
",$P(ND4,"^",12):"D",V!$P(ND4,"^",19)&$P(ND4,"^",18):"H",V!$P(ND4,"^",23)&$P(ND4,"^",22):"H",V!$
P(ND4,"^",16)&$P(ND4,"^",15):"R",1:" ")
"RTN","PSGO",48,0)
.W $S($P(DO,U,4)="D":"d",1:" ")_$S(V:"->",1:" ")
"RTN","PSGO",49,0)
I ($P(C,"^")="Cz")&(($P(C,"^",4)="CA")!($P(C,"^",4)["B")) W $S($P(ND4,"^",12):"D",1:" ") I
($P(C,"^",4)["B") S PSGONF=$S('$G(PSGONF):ON_U_ON,1:+PSGONF_U_ON)
"RTN","PSGO",50,0)
I ($P(C,"^")'="Cz") I C="CA"!(C["B") W $S($P(ND4,"^",12):"D",1:" ") I C["B" S
PSGONF=$S('$G(PSGONF):ON_U_ON,1:+PSGONF_U_ON)
"RTN","PSGO",51,0)
S SM=2-
$S('$P(ND,"^",5):2,1:$P(ND,"^",6)),STS=$S($P(ND,U,28)]"":$P(ND,U,28),$P(ND,"^",9)]"":$P(ND,"^",9),1:"
NF"),PF=$E("*",$P(ND,"^",20)>0),PSGID=$P(SCH,"^",2),SD=$P(SCH,"^",4) D
"RTN","PSGO",52,0)
.I ($P(C,"^")["C"&($P(C,"^")'["z"))!($P(C,"^",4)["C") S (PSGID,SD)="",PSGOD="********"
"RTN","PSGO",53,0)
I STS="A",($P(ND,U,27)="R") S STS="R"
"RTN","PSGO",54,0)
;S WS=0,PSGOD=$$ENDTC^PSGMI(PSGID) ;#373
"RTN","PSGO",55,0)
S WS=0,PSGOD=$$ENDTC2^PSGMI(PSGID) ;#373 START DATE
"RTN","PSGO",56,0)
S:PSJPWD WS=$$WS^PSJO(PSJPWD,PSGP,F,+O)
"RTN","PSGO",57,0)
NEW MARX
"RTN","PSGO",58,0)
S PSJORFLG=""
"RTN","PSGO",59,0)
S:($P(C,"^")'="Cz") PSJORFLG=+O_$S(C["B":"P",C["C":"P",1:"U") S:($P(C,"^")="Cz")
PSJORFLG=+O_$S($P(C,"^",4)["B":"P",$P(C,"^",4)["C":"P",1:"U")
"RTN","PSGO",60,0)
;D DRGDISP^PSJLMUT1(PSGP,PSJORFLG,40,54,.MARX,0) ;#373
"RTN","PSGO",61,0)
D DRGDISP^PSJLMUT1(PSGP,PSJORFLG,34,28,.MARX,0) ;#373
"RTN","PSGO",62,0)
NEW X F X=0:0 S X=$O(MARX(X)) Q:'X W @($S(X=1:"?9",1:"!?11")) W MARX(X) D ;D:X=1 #373
"RTN","PSGO",63,0)
. ;N RNDT,O2 S O2=O S:+O2=O O2=O2_"P" S RNDT=$$LASTREN^PSJLMPRI(PSGP,O2) I RNDT]"" S
RNDT=$E($$ENDTC^PSGMI(RNDT),1,5) ;#373
"RTN","PSGO",64,0)
. N O2 S RNDT="",O2=O S:+O2=O O2=O2_"P" S RNDT=$$LASTREN^PSJLMPRI(PSGP,O2) I RNDT]"" S
RNDT=$E($$ENDTC2^PSGMI(RNDT),1,10) ;#373
"RTN","PSGO",65,0)
. ;I ($P(C,"^")'="Cz") W ?50,$S(C["C":"?",ST'="z":ST,1:"?"),?53,$E(PSGOD,1,5) ;#373
"RTN","PSGO",66,0)
. ;I ($P(C,"^")="Cz") W ?50,$S($P(C,"^",4)["C":"?",ST'="z":ST,1:"?"),?53,$E(PSGOD,1,5) ;#373
"RTN","PSGO",67,0)
. I ($P(C,"^")'="Cz") W:X=1 ?46,$S(C["C":"?",ST'="z":ST,1:"?"),?49,$E(PSGOD,1,10) ;#373
"RTN","PSGO",68,0)
. I ($P(C,"^")="Cz") W:X=1 ?46,$S($P(C,"^",4)["C":"?",ST'="z":ST,1:"?"),?49,$E(PSGOD,1,10) ;#373
"RTN","PSGO",69,0)
. ;S SD=$$ENDTC^PSGMI(SD) W ?60,$E(SD,1,5),?67,STS ;#373
"RTN","PSGO",70,0)
. S SD=$$ENDTC2^PSGMI(SD) W:X=1 ?60,$E(SD,1,10),?71,STS ;#373
"RTN","PSGO",71,0)
. ;I NF!WS!SM!PF!RNDT W ?71 W:NF "NF " W:WS "WS " W:RNDT RNDT_" " W:SM $E("HSM",SM,3) W:PF
?79,"*" ;#373
"RTN","PSGO",72,0)
. I NF!WS!SM!PF D:X=1 ;#373
"RTN","PSGO",73,0)
.. W ?74 W:NF "NF " W:WS "WS " W:SM $E("HSM",SM,3) W:PF ?79,"*" ;#373
"RTN","PSGO",74,0)
. I RNDT]"",X=2 W ?49,"Renewed: ",$E(RNDT,1,10) ;#373
"RTN","PSGO",75,0)
I '$D(MARX(2)),RNDT]"" W !?49,"Renewed: ",$E(RNDT,1,10) ; in case no line 2 of Med #373
"RTN","PSGO",76,0)
K RNDT ; #373
"RTN","PSGO",77,0)
I ND6]"" S Y=$$ENSET^PSGSICHK($P(ND6,"^")) W !?11 F X=1:1:$L(Y," ") S V=$P(Y," ",X) W:$L(V)+$X>66
!?11 W V_" "
"RTN","PSGO",78,0)
K PSJORFLG
"RTN","PSGO",79,0)
Q
"RTN","PSGO",80,0)
;
"RTN","PSGO",81,0)
TF ;
"RTN","PSGO",82,0)
NEW SLS S SLS="",$P(SLS," -",40)=""
"RTN","PSGO",83,0)
I $P(C,"^")="Cz" Q:(TF2=$P(C,"^",2)) S TF2=$P(C,"^",2)
"RTN","PSGO",84,0)
S
LN2=$S(($P(C,"^")="Cz"):$$TXT^PSJO(C),C="A":$$TXT^PSJO("A"),C["CC":$$TXT^PSJO("PR"),C["CD":$$TX
T^PSJO("PC"),C["C":$$TXT^PSJO("P"),C["BD":$$TXT^PSJO("NC"),C["B":$$TXT^PSJO("N"),C="DF":$$TXT^P
SJO("DF"),1:$$TXT^PSJO("NA"))
"RTN","PSGO",85,0)
W:$D(^TMP("PSG",$J,C)) !,$E($E(SLS,1,(80-$L(LN2))/2)_" "_LN2_$E(SLS,1,(80-$L(LN2))/2),1,80)
"RTN","PSGO",86,0)
I $P(C,"^")'="Cz" S F="^PS("_$S(C["C":"53.1,",C["B":"53.1,",1:"55,"_PSGP_",5,",1:"53.1,") S
TF=$S(C["C":0,1:TF)
"RTN","PSGO",87,0)
I $P(C,"^")="Cz" N CCL S CCL=$P(C,"^",4) S
F="^PS("_$S(CCL["C":"53.1,",CCL["B":"53.1,",1:"55,"_PSGP_",5,",1:"53.1,") S TF=$S(CCL["C":0,1:TF)
"RTN","PSGO",88,0)
Q
"RTN","PSGO",89,0)
;
"RTN","PSGO",90,0)
GET ;
"RTN","PSGO",91,0)
S $P(LN2,"-",81)="",PG=$D(PSGVWA),(ON,PSGONC,PSGONR,PSGONV,SLS)="",$P(SLS," -
",15)="",TF=1,RB=$S(PSJPRB]"":PSJPRB,1:"*NF*"),WD=$S(PSJPWDN]"":PSJPWDN,PSJPWD:PSJPWD_";DIC
(42,",1:"*NF*")
"RTN","PSGO",92,0)
;
"RTN","PSGO",93,0)
NP I ON,'CML W $C(7) R !," '^' TO QUIT ",NP:DTIME W:'$T $C(7) S:'$T NP="^" W:NP'["^" $C(13),"
",$C(13),# Q
"RTN","PSGO",94,0)
I ON,CML D BOT
"RTN","PSGO",95,0)
Q:$G(PSGOL)="N"
"RTN","PSGO",96,0)
;
"RTN","PSGO",97,0)
HEADER ;
"RTN","PSGO",98,0)
S PG=PG+1
"RTN","PSGO",99,0)
S:'$D(PSJOPC) PSJOPC=1 S PSJTEAM=$S($D(PSJSEL("TM")):1,1:0)
"RTN","PSGO",100,0)
D ENTRY^PSJHEAD(PSGP,PSJOPC,PG,$G(PSJNARC),PSJTEAM)
"RTN","PSGO",101,0)
W:PG>1 !,$E(LN2,1,80) Q
"RTN","PSGO",102,0)
;
"RTN","PSGO",103,0)
BOT ;
"RTN","PSGO",104,0)
F Q=$Y:1:IOSL-4 W !
"RTN","PSGO",105,0)
W !,?2,$P(PSGP(0),"^"),?40,PSJPPID,?70,$E($P(PSJPDOB,"^",2),1,8) Q
"RTN","PSGO",106,0)
;
"RTN","PSGO",107,0)
ENHEAD ;
"RTN","PSGO",108,0)
K LN2,PSGPR,PSGPRP D NOW^%DTC S HDT=$$ENDTC^PSGMI(+$E(%,1,12)),PSGVWA=1,PSGOH="U N I T
D O S E P R O F I L E" D GET
"RTN","PSGO",109,0)
D D1 K PSGONC,PSGONR,PSGONV,PSGVWA Q
"RTN","PSGO",110,0)
;
"RTN","PSGO",111,0)
ENVBW ;
"RTN","PSGO",112,0)
S PSGOH=$S(PSGVBWTO=1:"N O N - V E R I F I E D O R D E R S",PSGVBWTO=2:"P E N D I N G O R D E R
S",1:"N O N - V E R I F I E D / P E N D I N G O R D E R S")
"RTN","PSGO",113,0)
D EN Q
"RTN","PSGO",114,0)
ENPR ;
"RTN","PSGO",115,0)
S PSGOH="U N I T D O S E P R O F I L E" G GET
"RTN","PSGO",116,0)
Q
"RTN","PSGOE41")
0^2^B102492308^B102492308
"RTN","PSGOE41",1,0)
PSGOE41 ;BIR/CML3 - REGULAR ORDER ENTRY (CONT.) ;Jul 02, 2018@09:07
"RTN","PSGOE41",2,0)
;;5.0;INPATIENT MEDICATIONS;**50,63,64,69,58,111,136,113,267,315,334,373**;16 DEC 97;Build 3
"RTN","PSGOE41",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","PSGOE41",4,0)
; Reference to ^DICN is supported by DBIA 10009.
"RTN","PSGOE41",5,0)
; Reference to %DT is supported by DBIA 10003.
"RTN","PSGOE41",6,0)
; Reference to %DTC is supported by DBIA 10000.
"RTN","PSGOE41",7,0)
; Reference to ^PS(51.1 is supported by DBIA 2177.
"RTN","PSGOE41",8,0)
; Reference to ^PS(50.7 is supported by DBIA# 2180
"RTN","PSGOE41",9,0)
;
"RTN","PSGOE41",10,0)
39 ; admin times
"RTN","PSGOE41",11,0)
G:$P(PSGNEDFD,"^",3)="P"!($P(PSGNEDFD,"^",3)="OC") 8
"RTN","PSGOE41",12,0)
I $$ODD^PSGS0(PSGS0XT) D PSGDUR G 8
"RTN","PSGOE41",13,0)
W !,"ADMIN TIMES: "_$S(PSGS0Y:PSGS0Y_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S
PSGOROE1=1,PSGDUR="" G DONE
"RTN","PSGOE41",14,0)
I X="",PSGS0Y]"" S PSGNOHI=1,X=PSGS0Y ;*315 If admin time default was taken then don't highlight
admin time.
"RTN","PSGOE41",15,0)
I X="",$G(PSGS0XT)="D" I $L(PSGSCH,"@")=2,$P(PSGSCH,"@",2) S (PSGAT,PSGS0Y)=$P(PSGSCH,"@",2)
G 8
"RTN","PSGOE41",16,0)
I X?1."?" D ENHLP^PSGOEM(53.1,39) G 39
"RTN","PSGOE41",17,0)
I X="@" D DEL G:%'=1 39 S (PSGFOK(39),PSGS0Y)="" G 39
"RTN","PSGOE41",18,0)
S PSGF2=39 I $E(X)="^" D FF G:Y>0 @Y G 39
"RTN","PSGOE41",19,0)
I (PSGS0XT="D")&('$G(X)!(X["@"&($P($G(X),"@",2)))) I ((",P,R,")'[(","_$G(PSGST)_",")) D G 39
"RTN","PSGOE41",20,0)
. W $C(7)," ??" S X="?" W !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." D
ENHLP^PSGOEM(53.1,39)
"RTN","PSGOE41",21,0)
.Q
"RTN","PSGOE41",22,0)
I $G(PSGS0XT)'="D",$G(PSGS0XT)'="P",$G(PSGS0XT)'="OC" D TIMES G:'$D(X) 39 D PSGDUR G:'$D(X) 39
G:$G(X)="^" DONE ;*315
"RTN","PSGOE41",23,0)
I $G(PSGS0XT)="O",X="" S (PSGAT,PSGS0Y)=X,PSGFOK(39)="" G 8
"RTN","PSGOE41",24,0)
D ENCHK^PSGS0 I '$D(X) W $C(7)," ??" G 39
"RTN","PSGOE41",25,0)
S (PSGAT,PSGS0Y)=X,PSGFOK(39)=""
"RTN","PSGOE41",26,0)
;
"RTN","PSGOE41",27,0)
8 ; special instructions
"RTN","PSGOE41",28,0)
S PSGSI=$$EDITSI^PSJBCMA5($G(PSGP),$G(PSGORD))
"RTN","PSGOE41",29,0)
S PSGF2=8 I $E(X)="^" D FF G:Y>0 @Y G 8
"RTN","PSGOE41",30,0)
I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G 8
"RTN","PSGOE41",31,0)
I X="@" D DEL G:%'=1 8 S (PSGFOK(8),PSGSI)="" G:'$G(PSGOE3) 10
"RTN","PSGOE41",32,0)
I X?1."?" D ENHLP^PSGOEM(53.1,8) G 8
"RTN","PSGOE41",33,0)
S PSGSI=$S((PSGSI>0&(PSGSI<3)):$G(^PS(53.45,+PSJSYSP,5,1,0))_"
"_$G(^PS(53.45,+PSJSYSP,5,2,0)),PSGSI>2:"Instructions too long. See Order View or BCMA for full
text",1:"")
"RTN","PSGOE41",34,0)
S:PSGSI=" " PSGSI="" I PSGSI]"" S PSGSI=$$ENBCMA^PSJUTL("U"),PSGFOK(8)=""
"RTN","PSGOE41",35,0)
Q:$G(PSGOE3)
"RTN","PSGOE41",36,0)
10 ; start date/time
"RTN","PSGOE41",37,0)
D ^PSGNE3
"RTN","PSGOE41",38,0)
S:'$D(PSGNESDO) PSGNESDO=$$ENDD^PSGMI(PSGNESD) S PSGSD=PSGNESDO
"RTN","PSGOE41",39,0)
A10 W !,"START DATE/TIME: "_PSGSD_"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
"RTN","PSGOE41",40,0)
I X="",PSGNESD W " "_PSGSD G O25
"RTN","PSGOE41",41,0)
I X="P" D ENPREV^PSGDL W:'$D(X) $C(7) G:'$D(X) A10 S PSGNESD=+X,PSGSD=$$ENDD^PSGMI(+X) W "
",PSGSD G O25
"RTN","PSGOE41",42,0)
S PSGF2=10 I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,10)
"RTN","PSGOE41",43,0)
I $E(X)="^" D FF G:Y>0 @Y G A10
"RTN","PSGOE41",44,0)
NEW TMPX S TMPX=X,X1=PSGDT,X2=-7 D C^%DTC K %DT S %DT="ERTX",%DT(0)=X,X=TMPX D ^%DT K
%DT I Y'>0 D ENHLP^PSGOEM(53.1,10) G A10
"RTN","PSGOE41",45,0)
; RBD PSJ*5*373 Soft stop when Start Date more than 7 days after Order's LOGIN DATE
"RTN","PSGOE41",46,0)
S X1=PSGDT,X2=+7 D C^%DTC
"RTN","PSGOE41",47,0)
I +Y>X W !!,$C(7),"Start date/time should not be entered for more than 7 days after the",!,"order's
LOGIN DATE.",! K DIR D WAIT^VALM1
"RTN","PSGOE41",48,0)
S PSGNESD=+Y,PSGSD=$$ENDD^PSGMI(+Y),(PSGNEFD,PSGFD)=""
"RTN","PSGOE41",49,0)
;
"RTN","PSGOE41",50,0)
O25 ;
"RTN","PSGOE41",51,0)
S PSGFOK(10)="" I $P(PSGNEDFD,"^",3)="O" S PSGNEFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGNESD,PSGP) I
PSGNEFD]"" S PSGFD=$$ENDD^PSGMI(PSGNEFD)
"RTN","PSGOE41",52,0)
;
"RTN","PSGOE41",53,0)
25 ; stop date
"RTN","PSGOE41",54,0)
Q:$G(PSGOE3)
"RTN","PSGOE41",55,0)
I 'PSGNEFD D ENFD^PSGNE3(PSGDT) S PSGFD=PSGNEFDO
"RTN","PSGOE41",56,0)
N MSG,PSGTMPST S PSGTMPST=$G(PSGST) S:'+$G(PSGRF)
PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1) ;*315 One time orders for MRR's require message to
instruct pharmacists
"RTN","PSGOE41",57,0)
I +$G(PSGRF),$D(^PS(51.1,"AC","PSJ",$G(PSGSCH))) D
"RTN","PSGOE41",58,0)
. S:PSGTMPST=($G(PSGST)="R")
PSGST=$P($G(^PS(51.1,$O(^PS(51.1,"AC","PSJ",$G(PSGSCH),"")),0)),"^",5) ;Handle "Fill on Request"
"RTN","PSGOE41",59,0)
.Q
"RTN","PSGOE41",60,0)
I $G(PSGTMPST)="O",+$G(PSGRF) S (PSGNEFD,PSGFD)="" D
"RTN","PSGOE41",61,0)
. I +$G(PSGRF)=1 S MSG(1)="This NOW order has an Orderable Item for which a removal is required" D
"RTN","PSGOE41",62,0)
.. S MSG(2)=" at the next administration."
"RTN","PSGOE41",63,0)
.. S MSG(3)="The Stop DATE/TIME entered should be the next anticipated administration for the
medication.",MSG(3,"F")="!"
"RTN","PSGOE41",64,0)
..Q
"RTN","PSGOE41",65,0)
. I +$G(PSGRF)=2 S MSG(1)="This NOW order has an Orderable Item for which a removal period is
optional",MSG(1,"F")="!!" D
"RTN","PSGOE41",66,0)
.. S MSG(2)="prior to the next administration.",MSG(2,"F")="!"
"RTN","PSGOE41",67,0)
.. S MSG(3)="If Early Removal is needed, enter Removal Time in Stop DATE/TIME field.",MSG(3,"F")="!"
"RTN","PSGOE41",68,0)
.. S MSG(4)="If an Early Removal is not required, the Stop DATE/TIME entered"
"RTN","PSGOE41",69,0)
.. S MSG(5)="should be the next anticipated administration for the medication.",MSG(5,"F")="!"
"RTN","PSGOE41",70,0)
..Q
"RTN","PSGOE41",71,0)
. I +$G(PSGRF)=3 S MSG(1)="This NOW order has an Orderable Item that requires a removal period
prior",MSG(1,"F")="!!" D
"RTN","PSGOE41",72,0)
.. S MSG(2)=" to the next administration.",MSG(2,"F")="!"
"RTN","PSGOE41",73,0)
.. S MSG(3)="Please Enter the Stop DATE/TIME to reflect the Removal Time for this
medication.",MSG(3,"F")="!"
"RTN","PSGOE41",74,0)
..Q
"RTN","PSGOE41",75,0)
. D EN^DDIOL(.MSG)
"RTN","PSGOE41",76,0)
.Q
"RTN","PSGOE41",77,0)
A25 W !,"STOP DATE/TIME: "_$S(PSGFD]"":PSGFD_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S
PSGOROE1=1 G DONE
"RTN","PSGOE41",78,0)
I X="",PSGNEFD W " "_PSGFD S PSGFOK(25)="" G W25
"RTN","PSGOE41",79,0)
S PSGF2=25 I $E(X)="^" D FF G:Y>0 @Y G A25
"RTN","PSGOE41",80,0)
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,25)
"RTN","PSGOE41",81,0)
I X=+X,(X>0),(X'>2000000) G A25:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X W " ...dose limit..." D
EN1^PSGDL
"RTN","PSGOE41",82,0)
K %DT S %DT="ERTX",%DT(0)=PSGNESD D ^%DT K %DT I Y'>0 W $C(7),!!?13,"*** WARNING! INVALID
STOP DATE OR PRIOR TO START DATE! ***",! G A25
"RTN","PSGOE41",83,0)
; RBD PSJ*5*373 Hard stop when Stop Date more than 367 days after Start Date
"RTN","PSGOE41",84,0)
S X1=+Y,X2=PSGNESD D ^%DTC
"RTN","PSGOE41",85,0)
I X>367 W $C(7),!!?13,"*** STOP DATE cannot be more than 367 days from START DATE ***",! G A25
"RTN","PSGOE41",86,0)
S PSGNEFD=+Y,PSGFD=$$ENDD^PSGMI(+Y),PSGFOK(25)=""
"RTN","PSGOE41",87,0)
W25 ;
"RTN","PSGOE41",88,0)
N Z
"RTN","PSGOE41",89,0)
D DOSE I $G(Z)]"",Z>PSGNEFD D G A25
"RTN","PSGOE41",90,0)
. W !,"There must be an admin time that falls between the Start Date/Time"
"RTN","PSGOE41",91,0)
. W !,"and the Stop Date/Time."
"RTN","PSGOE41",92,0)
I PSGNEFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
"RTN","PSGOE41",93,0)
D EFDNEW^PSJUTL ;Display Expected First Dose;BHW;PSJ*5*136
"RTN","PSGOE41",94,0)
I $G(PSGDUR),'$G(PSGOROE1) D VERTIMES ;*315
"RTN","PSGOE41",95,0)
NEXT ;
"RTN","PSGOE41",96,0)
S:'+$G(PSGRF) PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1)
"RTN","PSGOE41",97,0)
G:'$D(PSGAARR) 1^PSGOE42
"RTN","PSGOE41",98,0)
;
"RTN","PSGOE41",99,0)
DONE ;
"RTN","PSGOE41",100,0)
I PSGOROE1 K Y W $C(7)," ...order not entered..."
"RTN","PSGOE41",101,0)
K F,F0,F1,PSGF2,F3,PSG,SDT Q
"RTN","PSGOE41",102,0)
;
"RTN","PSGOE41",103,0)
FF ; up-arrow to another field
"RTN","PSGOE41",104,0)
D ENFF^PSGOEM I Y>0,Y'=39,Y'=8,Y'=10,Y'=25 S
Y=Y_"^PSGOE4"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2) S:$P(Y,U)=2 FB=PSGF2_"^PSGOE41"
"RTN","PSGOE41",105,0)
Q
"RTN","PSGOE41",106,0)
;
"RTN","PSGOE41",107,0)
DEL ; delete entry
"RTN","PSGOE41",108,0)
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
"RTN","PSGOE41",109,0)
Q
"RTN","PSGOE41",110,0)
TIMES ;At least one admin time, not more than interval allows.
"RTN","PSGOE41",111,0)
I $G(PSGS0XT)'="O",X="" W !,"This order requires at least one administration time." K X Q ;No times
"RTN","PSGOE41",112,0)
N H,I,MAX
"RTN","PSGOE41",113,0)
I PSGSCH]"" I $D(^PS(51.1,"AC","PSJ",PSGSCH)) S H=+$O(^PS(51.1,"AC","PSJ",PSGSCH,0)) S
I=$P($G(^PS(51.1,H,0)),"^",3)
"RTN","PSGOE41",114,0)
I $G(PSGST)="O",$L(X,"-")>1 W !,"This is a One Time Order - only one admin time is permitted." K X Q
"RTN","PSGOE41",115,0)
I $G(PSGST)="O" Q ;Done validating One Time
"RTN","PSGOE41",116,0)
I +$G(I)=0 Q ;No frequency - can not check frequency related items
"RTN","PSGOE41",117,0)
S MAX=1440/I
"RTN","PSGOE41",118,0)
I MAX<1 D Q
"RTN","PSGOE41",119,0)
. I $L(X,"-")'=1 W !,"This order requires one admin time." K X Q
"RTN","PSGOE41",120,0)
I MAX'<1,$L(X,"-")>MAX W !,"The number of admin times entered is greater than indicated by the
schedule." K X Q ;Too many times
"RTN","PSGOE41",121,0)
I MAX'<1,$L(X,"-")<MAX W !,"The number of admin times entered is fewer than indicated by the
schedule." ;Too few times
"RTN","PSGOE41",122,0)
Q
"RTN","PSGOE41",123,0)
DOSE ;Make certain at least one dose is given.
"RTN","PSGOE41",124,0)
Q:$G(PSGST)="OC"!($G(PSGST)="P")
"RTN","PSGOE41",125,0)
N INFO,X
"RTN","PSGOE41",126,0)
S
Z="",INFO=($G(PSGNESD))_U_($G(PSGNEFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGDRG))_U_($
G(PSGS0Y))
"RTN","PSGOE41",127,0)
I '$L($G(PSGP)) N PSGP S PSGP=""
"RTN","PSGOE41",128,0)
S Z=$$ENQ^PSJORP2(PSGP,INFO) ;Expected first dose.
"RTN","PSGOE41",129,0)
Q
"RTN","PSGOE41",130,0)
;
"RTN","PSGOE41",131,0)
;*315 new tags
"RTN","PSGOE41",132,0)
PSGDUR ; Prompt for Removal times if admin times are on 24hr rotations and Site Params are enabled.
"RTN","PSGOE41",133,0)
; check parameter files for removal criteria quit if removal rotation not enabled (<2)
"RTN","PSGOE41",134,0)
; if enabled determine type (hard vers soft stop)
"RTN","PSGOE41",135,0)
;0 = no removal (current cap/tab functionality)
"RTN","PSGOE41",136,0)
;1 = removal at next admin (current patch functionality)
"RTN","PSGOE41",137,0)
;2 = removal prior to next admin; soft stop (pharmacist optional prompt to designate duration of
administration
"RTN","PSGOE41",138,0)
;3 = removal prior to next admin; hard stop (pharmacist required prompt to designate duration of
administration)
"RTN","PSGOE41",139,0)
; prompt for removal if = 2 then allow skip, if = 3 then force entry
"RTN","PSGOE41",140,0)
;
"RTN","PSGOE41",141,0)
S PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1)
Q:((PSGRF<2)!($G(PSGST)="O")!($G(PSGST)="P")!($G(PSGST)="OC")) ; no removal flag or no removal
rotation
"RTN","PSGOE41",142,0)
Q:$G(PSGS0XT)>1440 ; Duration of Administration valid only for 24 hours - subject to change in future.
"RTN","PSGOE41",143,0)
N RP,PSGIDF,WMSG,PSGDERR S (PSGIDF,PSGDERR)=0 S:$G(PSGDUR)>0 RP=PSGDUR/60
S:"BID,TID,QID"[$G(PSGSCH) PSGIDF=1 ; Use separate validation for Times Per Day type orders
"RTN","PSGOE41",144,0)
S PSGF2=39
"RTN","PSGOE41",145,0)
W !,"DURATION OF ADMINISTRATION (HRS): "_$S($G(RP):RP_"// ",1:"") R RP:DTIME I RP="^"!'$T W:'$T
$C(7) S PSGOROE1=1,X="^" K PSGFOK(39) Q
"RTN","PSGOE41",146,0)
I RP="",$G(PSGS0XT)="D" I $L(PSGSCH,"@")=2,$P(PSGSCH,"@",2) S
(PSGAT,PSGRMV)=$P(PSGSCH,"@",2) G 8
"RTN","PSGOE41",147,0)
I RP="@",PSGRF'=3 D DEL G:%'=1 PSGDUR S (PSGFOK(39),PSGS0Y,PSGDUR,PSGRMVT)="",PSGRMV=-1
S:+$G(^PS(53.1,+$G(PSGORD),2.1)) (PSGDUR,PSGRMVT)="@" Q
"RTN","PSGOE41",148,0)
I (RP'=""),(RP'="@"),($E(RP)'="^"),($E(RP)'="?") S:(RP'?1N.2N)!(+(RP)<1) RP="?"
"RTN","PSGOE41",149,0)
I RP?1."?" D DURHLP^PSGOEM(RP,PSGRF) G PSGDUR
"RTN","PSGOE41",150,0)
I $E(RP)="^" D FF G:Y>0 @Y G PSGDUR
"RTN","PSGOE41",151,0)
I (+RP>0),'PSGIDF D ; exclude TPD schedules
"RTN","PSGOE41",152,0)
. S PSGDUR=(RP*60),PSGRMV=$G(PSGS0XT)-PSGDUR
"RTN","PSGOE41",153,0)
. I PSGRMV<1 W !,"DURATION OF ADMINISTRATION MATCHES OR EXCEEDS ORDER FREQUENCY" S
RP="",PSGDERR=1 K PSGDUR,PSGRMV G PSGDUR
"RTN","PSGOE41",154,0)
.Q
"RTN","PSGOE41",155,0)
Q:$G(PSGDERR)=1
"RTN","PSGOE41",156,0)
I PSGRF=3,(+RP<1) W !,"ENTRY IS REQUIRED" S RP="" G PSGDUR
"RTN","PSGOE41",157,0)
I PSGRF=2,(+RP<1) D
"RTN","PSGOE41",158,0)
. W !,"You have not entered Duration of Administration for this medication order, "
"RTN","PSGOE41",159,0)
. W !,"therefore the BCMA user will not be prompted to remove the medication prior "
"RTN","PSGOE41",160,0)
. W !,"to the next Admin Time."
"RTN","PSGOE41",161,0)
. S PSGRMV=-1,RP=0
"RTN","PSGOE41",162,0)
.Q
"RTN","PSGOE41",163,0)
I PSGIDF,(+RP>0) D ;Only for TPD schedules
"RTN","PSGOE41",164,0)
. N F,P,PSGARR
"RTN","PSGOE41",165,0)
. S PSGADT=$S($G(PSGDUR)=-1:X,$G(PSGS0Y):PSGS0Y,$G(PSGAT):PSGAT,1:""),PSGAT=PSGADT
"RTN","PSGOE41",166,0)
. S PSGARR=$L($G(PSGADT),"-")
"RTN","PSGOE41",167,0)
. F P=1:1:PSGARR D
"RTN","PSGOE41",168,0)
.. S PSGARR(P)=($P(PSGADT,"-",P)/100) S:(P>1) F(P)=PSGARR(P)-PSGARR(P-1)
"RTN","PSGOE41",169,0)
.. I $G(F(P)),($G(F(P))'=RP) S WMSG=1_U_"Duration of Administration does not correspond to one or
more",WMSG(1)="of this order's scheduled Administration Times!"
"RTN","PSGOE41",170,0)
..Q
"RTN","PSGOE41",171,0)
.Q
"RTN","PSGOE41",172,0)
S:(+RP>0) PSGDUR=(RP*60)
"RTN","PSGOE41",173,0)
W:(+RP>0) ?60,RP," HOURS"
"RTN","PSGOE41",174,0)
D:$G(WMSG) EN^DDIOL($P(WMSG,U,2)),EN^DDIOL(WMSG(1))
"RTN","PSGOE41",175,0)
Q:'$G(PSGOE3)!'+$G(PSGDUR)
"RTN","PSGOE41",176,0)
;
"RTN","PSGOE41",177,0)
VERTIMES ; Redisplay Admin and Removal times
"RTN","PSGOE41",178,0)
S PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1) Q:(PSGRF<2)!($G(PSGST)="O")
"RTN","PSGOE41",179,0)
N PSGADT,PSGRARR,PSGAARR
"RTN","PSGOE41",180,0)
;If we have a frequency and this is odd type order then we need to start calculations with order start
time.
"RTN","PSGOE41",181,0)
I $G(PSGS0XT),$G(PSGNESD),+$G(PSGDUR),$G(PSGAT)="",$G(PSGS0Y)="" D Q
"RTN","PSGOE41",182,0)
. N L
"RTN","PSGOE41",183,0)
. S (PSGAARR,PSGRARR)=1,PSGADT=$P($P(PSGNESD,U,1),".",2),L=$L(PSGADT)
"RTN","PSGOE41",184,0)
. S PSGRARR(1)=(((((PSGADT*60)+PSGDUR)/60)#24)*100) S:PSGRARR(1)=0 PSGRARR(1)=2400
S:$L(PSGRARR(1))=3 PSGRARR(1)="0"_PSGRARR(1)
"RTN","PSGOE41",185,0)
. S PSGRARR(1)=$E(PSGRARR(1),1,L)_"(R)"
"RTN","PSGOE41",186,0)
. S PSGAARR(1)=PSGADT,PSGAARR(1)=$E(PSGAARR(1),1,L)_"(A)"
"RTN","PSGOE41",187,0)
. D WRITE
"RTN","PSGOE41",188,0)
.Q
"RTN","PSGOE41",189,0)
;
"RTN","PSGOE41",190,0)
S (PSGRARR,PSGAARR)=$S($G(PSGAT):$L(PSGAT,"-"),1:$L(PSGS0Y,"-"))
"RTN","PSGOE41",191,0)
N P,L
"RTN","PSGOE41",192,0)
F P=1:1:PSGRARR D
"RTN","PSGOE41",193,0)
. S PSGADT=$S($G(PSGAT):$P(PSGAT,"-",P),1:$P(PSGS0Y,"-",P)),L=$L(PSGADT)
"RTN","PSGOE41",194,0)
. S PSGADT=$S($L(PSGADT)=4:PSGADT/100,1:PSGADT*1)
"RTN","PSGOE41",195,0)
. S PSGRARR(P)=(((((PSGADT*60)+PSGDUR)/60)#24)*100) S:PSGRARR(P)=0 PSGRARR(P)=2400
S:$L(PSGRARR(P))=3 PSGRARR(P)="0"_PSGRARR(P)
"RTN","PSGOE41",196,0)
. S PSGRARR(P)=$E(PSGRARR(P),1,L)_"(R)"
"RTN","PSGOE41",197,0)
. S PSGAARR(P)=(PSGADT*100) S:$L(PSGAARR(P))=3 PSGAARR(P)="0"_PSGAARR(P)
"RTN","PSGOE41",198,0)
. S PSGAARR(P)=$E(PSGAARR(P),1,L)_"(A)"
"RTN","PSGOE41",199,0)
.Q
"RTN","PSGOE41",200,0)
D WRITE
"RTN","PSGOE41",201,0)
Q
"RTN","PSGOE41",202,0)
;
"RTN","PSGOE41",203,0)
WRITE ;
"RTN","PSGOE41",204,0)
W !!,"Verify Admin and removal times",!
"RTN","PSGOE41",205,0)
W !,"(A)DMINISTRATION -(R)EMOVAL TIMES"
"RTN","PSGOE41",206,0)
W !,"___________________________________________________________________________",!
"RTN","PSGOE41",207,0)
F P=1:1:PSGAARR W PSGAARR(P)_"-"_PSGRARR(P) W:P'=PSGAARR " , "
"RTN","PSGOE41",208,0)
D ASK
"RTN","PSGOE41",209,0)
Q
"RTN","PSGOE41",210,0)
;
"RTN","PSGOE41",211,0)
ASK ;
"RTN","PSGOE41",212,0)
N Y
"RTN","PSGOE41",213,0)
S DIR("A")="Is this correct",DIR(0)="Y" D ^DIR I $D(DUOUT)!$D(DTOUT) W:'$T $C(7) S PSGOEE=0 K
PSGDUR G DONE
"RTN","PSGOE41",214,0)
I 'Y K X S PSGDUR=-1 G 39
"RTN","PSGOE41",215,0)
N P S P=1,PSGRMVT=$P(PSGRARR(P),"(",1)
"RTN","PSGOE41",216,0)
F S P=$O(PSGRARR(P)) Q:P="" D
"RTN","PSGOE41",217,0)
. S PSGRMVT=PSGRMVT_"-"_$P(PSGRARR(P),"(",1)
"RTN","PSGOE41",218,0)
.Q
"RTN","PSGOE41",219,0)
Q
"RTN","PSGOE41",220,0)
;
"RTN","PSGOE81")
0^3^B115959656^B115958942
"RTN","PSGOE81",1,0)
PSGOE81 ;BIR/CML3 - NON-VERIFIED ORDER EDIT (CONT.) ;Jul 02, 2018@09:10
"RTN","PSGOE81",2,0)
;;5.0;INPATIENT MEDICATIONS;**26,50,64,58,82,110,111,136,113,267,315,334,373**;16 DEC 97;Build
3
"RTN","PSGOE81",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","PSGOE81",4,0)
; Reference to ^PS(50.7 is supported by DBIA# 2180
"RTN","PSGOE81",5,0)
; Reference to ^PS(51.1 is supported by DBIA 2177.
"RTN","PSGOE81",6,0)
;
"RTN","PSGOE81",7,0)
39 ; admin times
"RTN","PSGOE81",8,0)
N PSGDOA
"RTN","PSGOE81",9,0)
S MSG=0,PSGF2=39 S:PSGOEEF(PSGF2) BACK="39^PSGOE81",ORIG=$G(PSGAT),PSGDOA=$G(PSGDUR)
"RTN","PSGOE81",10,0)
A39 ;*315 next 2 lines
"RTN","PSGOE81",11,0)
I (PSGST="P")!$$PRNOK^PSGS0($G(PSGSCH)) G DONE
"RTN","PSGOE81",12,0)
I $$ODD^PSGS0(PSGS0XT) D PSGDUR G DONE
"RTN","PSGOE81",13,0)
W !,"ADMIN TIMES: "_$S(PSGAT:PSGAT_"// ",1:"") R X:DTIME I X="^"!('$T) W:'$T $C(7) S PSGOEE=0
S:X="^" (X,PSGAT)=$G(ORIG),PSGDUR="" G DONE ;*315
"RTN","PSGOE81",14,0)
I X="" S:(($G(PSGS0XT)="D")&'$G(PSGS0Y)) PSGOEE=0 S:$G(PSGAT) X=PSGAT,PSGNOHI=1 ;*315 If admin
time default was taken then don't highlight admin time.
"RTN","PSGOE81",15,0)
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A39
"RTN","PSGOE81",16,0)
I X=" "!(X?1."?") D ENHLP^PSGOEM(53.1,39) G A39
"RTN","PSGOE81",17,0)
I PSGS0XT="D"&'$G(X) I ((",P,R,")'[(","_$G(PSGST)_",")) D G A39
"RTN","PSGOE81",18,0)
.W $C(7)," ??" S X="?" W !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." D
ENHLP^PSGOEM(53.1,39)
"RTN","PSGOE81",19,0)
I X="@" D DEL G:%'=1 A39 S PSGAT="",X=""
"RTN","PSGOE81",20,0)
I
$G(PSGS0XT),'$$ODD^PSGS0(PSGS0XT),$G(PSGS0XT)'="P",$G(PSGS0XT)'="OC",'$$PRNOK^PSGS0(PSGSC
H),($G(PSGST)'="O") D TIMES G:'$D(X) A39 D PSGDUR G:'$D(X) A39 G:$G(X)="^" DONE ;*315
"RTN","PSGOE81",21,0)
I (($G(PSGST)="O")!($G(PSGST)="OC")),X="" D G DONE
"RTN","PSGOE81",22,0)
. S (PSGS0Y,PSGAT)=X
"RTN","PSGOE81",23,0)
. I (($G(PSGRF))&($G(PSGST)="O")) N PSGRO S (PSGRO,PSGOEEF(25))=1,PSGOEEF(39)=1 D 25
"RTN","PSGOE81",24,0)
.Q
"RTN","PSGOE81",25,0)
D ENCHK^PSGS0 I '$D(X) W $C(7) G A39
"RTN","PSGOE81",26,0)
S PSGOAT=PSGAT
"RTN","PSGOE81",27,0)
S (PSGS0Y,PSGAT)=X G DONE
"RTN","PSGOE81",28,0)
;
"RTN","PSGOE81",29,0)
8 ; special instructions
"RTN","PSGOE81",30,0)
S MSG=0,PSGF2=8 S:PSGOEEF(PSGF2) BACK="8^PSGOE81"
"RTN","PSGOE81",31,0)
A8 ; special instructions
"RTN","PSGOE81",32,0)
S PSGSI=$$EDITSI^PSJBCMA5($G(PSGP),$G(PSGORD)) I $G(PSGP),$G(PSGORD) I
'$$DIFFSI^PSJBCMA5(PSGP,PSGORD) S PSGOEE=0 G DONE
"RTN","PSGOE81",33,0)
S PSGSI=$S((PSGSI>0&(PSGSI<4)):$G(^PS(53.45,+PSJSYSP,5,1,0))_"
"_$G(^PS(53.45,+PSJSYSP,5,2,0)),PSGSI>3:"Instructions too long. See Order View or BCMA for full
text",1:"")
"RTN","PSGOE81",34,0)
S:PSGSI=" " PSGSI="" I PSGSI]"" S PSGSI=$$ENBCMA^PSJUTL("U") G DONE
"RTN","PSGOE81",35,0)
Q
"RTN","PSGOE81",36,0)
;
"RTN","PSGOE81",37,0)
10 ; start date/time
"RTN","PSGOE81",38,0)
S MSG=0,PSGF2=10 S:PSGOEEF(PSGF2) BACK="10^PSGOE81"
"RTN","PSGOE81",39,0)
A10 ; start date/time
"RTN","PSGOE81",40,0)
K PSGSDX N DUR,DURMIN,TMPFD
"RTN","PSGOE81",41,0)
I $G(PSGORD)["P",$G(PSGP) I $$LASTREN^PSJLMPRI(PSGP,PSGORD) D Q
"RTN","PSGOE81",42,0)
. W !?5,"Start Date may not be edited at this point. " D PAUSE^VALM1
"RTN","PSGOE81",43,0)
W !,"START DATE/TIME: "_$S($P(PSGSDN,"^")]"":$P(PSGSDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T
W:'$T $C(7) S PSGOEE=0 G DONE
"RTN","PSGOE81",44,0)
I X="",PSGSD W " "_$P(PSGSDN,"^") G DONE
"RTN","PSGOE81",45,0)
I X="P" D ENPREV^PSGDL W:'$D(X) $C(7) G:'$D(X) A10 S
PSGSD=+X,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD) W " ",$P(PSGSDN,"^") G
DONE
"RTN","PSGOE81",46,0)
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,10)
"RTN","PSGOE81",47,0)
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A10
"RTN","PSGOE81",48,0)
NEW TMPX S TMPX=X,X1=+$G(PSGLI),X2=-7 D C^%DTC K %DT S %DT="ERTX",%DT(0)=X,X=TMPX D
^%DT K %DT I Y'>0 D ENHLP^PSGOEM(53.1,10) G A10
"RTN","PSGOE81",49,0)
I PSGFD<Y W $C(7),!?5,"*** THE START DATE CANNOT BE AFTER THE STOP DATE! ***",! S MSG=1 G A10
"RTN","PSGOE81",50,0)
; RBD PSJ*5*373 Soft stop when Start Date more than 7 days after Order's LOGIN DATE
"RTN","PSGOE81",51,0)
S X1=+$G(PSGLI),X2=+7 D C^%DTC
"RTN","PSGOE81",52,0)
I +Y>X W !!,$C(7),"Start date/time should not be entered for more than 7 days after the",!,"order's
LOGIN DATE.",! K DIR D WAIT^VALM1
"RTN","PSGOE81",53,0)
;S (PSGSDX,PSGSD,PSGNESD)=+Y,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD) ;373
"RTN","PSGOE81",54,0)
S (PSGSDX,PSGSD,PSGNESD)=+Y,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC2^PSGMI(PSGSD) ;373
"RTN","PSGOE81",55,0)
I $G(PSGORD)["P",$G(PSGP) S DUR=$$GETDUR^PSJLIVMD(PSGP,+PSGORD,"P",1) I DUR]"" S
DURMIN=$$DURMIN^PSJLIVMD(DUR) I DURMIN D
"RTN","PSGOE81",56,0)
. ;S TMPFD=$$FMADD^XLFDT(PSGSD,,,DURMIN) K:(TMPFD<PSGSD) TMPFD I $G(TMPFD) S
PSGFD=TMPFD,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD) ;373
"RTN","PSGOE81",57,0)
. S TMPFD=$$FMADD^XLFDT(PSGSD,,,DURMIN) K:(TMPFD<PSGSD) TMPFD I $G(TMPFD) S
PSGFD=TMPFD,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC2^PSGMI(PSGFD) ;373
"RTN","PSGOE81",58,0)
G DONE
"RTN","PSGOE81",59,0)
;
"RTN","PSGOE81",60,0)
25 ; stop date
"RTN","PSGOE81",61,0)
S MSG=0,PSGF2=25 S:PSGOEEF(PSGF2) BACK="25^PSGOE81"
"RTN","PSGOE81",62,0)
A25 ;
"RTN","PSGOE81",63,0)
N MSG,PSGTMPST S PSGTMPST=$G(PSGST) S:'+$G(PSGRF)
PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1) ;*315 One time orders for MRR's require message to
instruct pharmacists
"RTN","PSGOE81",64,0)
I +$G(PSGRF),$D(^PS(51.1,"AC","PSJ",$G(PSGSCH))) D
"RTN","PSGOE81",65,0)
. S:PSGTMPST=($G(PSGST)="R")
PSGST=$P($G(^PS(51.1,$O(^PS(51.1,"AC","PSJ",$G(PSGSCH),"")),0)),"^",5) ;Handle "Fill on Request"
"RTN","PSGOE81",66,0)
.Q
"RTN","PSGOE81",67,0)
I $G(PSGTMPST)="O",+$G(PSGRF) S (PSGFDN,PSGFD)="" D
"RTN","PSGOE81",68,0)
. I +$G(PSGRF)=1 S MSG(1)="This NOW order has an Orderable Item for which a removal is required" D
"RTN","PSGOE81",69,0)
.. S MSG(2)=" at the next administration."
"RTN","PSGOE81",70,0)
.. S MSG(3)="The Stop DATE/TIME entered should be the next anticipated administration for the
medication.",MSG(3,"F")="!"
"RTN","PSGOE81",71,0)
..Q
"RTN","PSGOE81",72,0)
. I +$G(PSGRF)=2 S MSG(1)="This NOW order has an Orderable Item for which a removal period is
optional",MSG(1,"F")="!!" D
"RTN","PSGOE81",73,0)
.. S MSG(2)="prior to the next administration.",MSG(2,"F")="!"
"RTN","PSGOE81",74,0)
.. S MSG(3)="If Early Removal is needed, enter Removal Time in Stop DATE/TIME field.",MSG(3,"F")="!"
"RTN","PSGOE81",75,0)
.. S MSG(4)="If an Early Removal is not required, the Stop DATE/TIME entered"
"RTN","PSGOE81",76,0)
.. S MSG(5)="should be the next anticipated administration for the medication.",MSG(5,"F")="!"
"RTN","PSGOE81",77,0)
..Q
"RTN","PSGOE81",78,0)
. I +$G(PSGRF)=3 S MSG(1)="This NOW order has an Orderable Item that requires a removal period
prior",MSG(1,"F")="!!" D
"RTN","PSGOE81",79,0)
.. S MSG(2)=" to the next administration.",MSG(2,"F")="!"
"RTN","PSGOE81",80,0)
.. S MSG(3)="Please Enter the Stop DATE/TIME to reflect the Removal Time for this
medication.",MSG(3,"F")="!"
"RTN","PSGOE81",81,0)
..Q
"RTN","PSGOE81",82,0)
. D EN^DDIOL(.MSG)
"RTN","PSGOE81",83,0)
.Q
"RTN","PSGOE81",84,0)
K PSGFDX
"RTN","PSGOE81",85,0)
W !,"STOP DATE/TIME: "_$S($P(PSGFDN,"^")]"":$P(PSGFDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T
$C(7) S PSGOEE=0 G DONE
"RTN","PSGOE81",86,0)
I X="",PSGFD S X=$P(PSGFDN,"^")
"RTN","PSGOE81",87,0)
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A25
"RTN","PSGOE81",88,0)
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,25)
"RTN","PSGOE81",89,0)
I X=+X,(X>0),(X'>2000000) G A25:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X W " ...dose limit..." D
ENE^PSGDL
"RTN","PSGOE81",90,0)
K %DT S %DT="ERTX",%DT(0)=PSGSD D ^%DT K %DT I Y'>0 W $C(7),!!?13,"*** WARNING! INVALID STOP
DATE OR PRIOR TO START DATE! ***",! G A25
"RTN","PSGOE81",91,0)
; RBD PSJ*5*373 Hard stop when Stop Date more than 367 days after Start Date
"RTN","PSGOE81",92,0)
S X1=+Y,X2=PSGSD D ^%DTC
"RTN","PSGOE81",93,0)
I X>367 W $C(7),!!?13,"*** STOP DATE cannot be more than 367 days from START DATE ***",! G A25
"RTN","PSGOE81",94,0)
;S (PSGFDX,PSGFD,PSGNEFD)=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD) ;373
"RTN","PSGOE81",95,0)
S (PSGFDX,PSGFD,PSGNEFD)=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC2^PSGMI(PSGFD) ;373
"RTN","PSGOE81",96,0)
W25 ;
"RTN","PSGOE81",97,0)
N Z,MSG
"RTN","PSGOE81",98,0)
D DOSE I $G(Z)]"",Z>PSGNEFD D G A25
"RTN","PSGOE81",99,0)
. S MSG(1)="There is no administration time that falls between the Start Date/Time"
"RTN","PSGOE81",100,0)
. S MSG(2)="and the Stop Date/Time."
"RTN","PSGOE81",101,0)
. D EN^DDIOL(.MSG)
"RTN","PSGOE81",102,0)
I PSGFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",! S
MSG=1
"RTN","PSGOE81",103,0)
Q:+$G(PSGRO)
"RTN","PSGOE81",104,0)
;
"RTN","PSGOE81",105,0)
DONE ;
"RTN","PSGOE81",106,0)
;Display Expected First Dose;BHW;PSJ*5*136
"RTN","PSGOE81",107,0)
D EFDNV^PSJUTL
"RTN","PSGOE81",108,0)
I PSGOEE G:'PSGOEEF(PSGF2) @BACK S PSGOEE=PSGOEEF(PSGF2)
"RTN","PSGOE81",109,0)
D:+$G(PSGDUR) VERTIMES ;*315
"RTN","PSGOE81",110,0)
K ORIG
"RTN","PSGOE81",111,0)
S:'+$G(PSGRF) PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1)
"RTN","PSGOE81",112,0)
Q
"RTN","PSGOE81",113,0)
;
"RTN","PSGOE81",114,0)
FF ; up-arrow to another field
"RTN","PSGOE81",115,0)
D ENFF^PSGOEM I Y>0,Y'=39,Y'=8,Y'=10,Y'=25 S
Y=Y_"^PSGOE8"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2) S:Y=2 FB=PSGF2_"^PSGOE81"
"RTN","PSGOE81",116,0)
Q
"RTN","PSGOE81",117,0)
;
"RTN","PSGOE81",118,0)
DEL ; delete entry
"RTN","PSGOE81",119,0)
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
"RTN","PSGOE81",120,0)
Q
"RTN","PSGOE81",121,0)
;
"RTN","PSGOE81",122,0)
TIMES ;At least one admin time, not more than interval allows.
"RTN","PSGOE81",123,0)
I ($G(PSGS0XT)'="O"),($G(PSGST)'="OC"),'$$PRNOK^PSGS0(PSGSCH) I X="" D EN^DDIOL("This order
requires at least one administration time.") K X Q ;No times
"RTN","PSGOE81",124,0)
N H,I,MAX
"RTN","PSGOE81",125,0)
I PSGSCH]"" I $D(^PS(51.1,"AC","PSJ",PSGSCH)) S H=+$O(^PS(51.1,"AC","PSJ",PSGSCH,0)) S
I=$P($G(^PS(51.1,H,0)),"^",3)
"RTN","PSGOE81",126,0)
I $G(PSGST)="O",$L(X,"-")>1 D EN^DDIOL("This is a One Time Order. Only one administration time is
permitted.") K X Q
"RTN","PSGOE81",127,0)
I $G(PSGST)="O" Q ;Done validating One Time
"RTN","PSGOE81",128,0)
I +$G(I)=0 Q ;No frequency - can not check frequency related items
"RTN","PSGOE81",129,0)
S MAX=1440/I
"RTN","PSGOE81",130,0)
I MAX<1,$L(X,"-")>1 D EN^DDIOL("This order requires one administration time.") K X Q
"RTN","PSGOE81",131,0)
I MAX'<1,$L(X,"-")>MAX D EN^DDIOL("The number of admin times entered is greater than indicated by
the schedule.") K X Q ;Too many times
"RTN","PSGOE81",132,0)
I MAX'<1,$L(X,"-")<MAX D EN^DDIOL("The number of admin times entered is fewer than indicated by
the schedule.") ;Too few times
"RTN","PSGOE81",133,0)
Q
"RTN","PSGOE81",134,0)
;
"RTN","PSGOE81",135,0)
DOSE ;Make certain at least one dose is given.
"RTN","PSGOE81",136,0)
N INFO,X
"RTN","PSGOE81",137,0)
S
Z="",INFO=$S($G(PSGNESD):PSGNESD,1:$G(PSGSD))_U_($G(PSGNEFD))_U_($G(PSGSCH))_U_($G(PSGST)
)_U_($G(PSGDRG))_U_($G(PSGS0Y))
"RTN","PSGOE81",138,0)
Q:$G(PSGST)="OC"!($G(PSGST)="P")
"RTN","PSGOE81",139,0)
I '$L($G(PSGP)) N PSGP S PSGP=""
"RTN","PSGOE81",140,0)
S Z=$$ENQ^PSJORP2(PSGP,INFO) ;Expected first dose.
"RTN","PSGOE81",141,0)
Q
"RTN","PSGOE81",142,0)
;
"RTN","PSGOE81",143,0)
;*315 new tags
"RTN","PSGOE81",144,0)
PSGDUR ; Prompt for Removal times if admin times are on 24hr rotations and Site Params are enabled.
"RTN","PSGOE81",145,0)
; check parameter files for removal criteria quit if removal rotation not enabled (<2)
"RTN","PSGOE81",146,0)
; if enabled determine type (hard vers soft stop)
"RTN","PSGOE81",147,0)
;0 = no removal (current cap/tab functionality)
"RTN","PSGOE81",148,0)
;1 = removal at next admin (current patch functionality)
"RTN","PSGOE81",149,0)
;2 = removal prior to next admin; soft stop (pharmacist optional prompt to designate duration of
administration
"RTN","PSGOE81",150,0)
;3 = removal prior to next admin; hard stop (pharmacist required prompt to designate duration of
administration)
"RTN","PSGOE81",151,0)
; prompt for removal if = 2 then allow skip, if = 3 then force entry
"RTN","PSGOE81",152,0)
;
"RTN","PSGOE81",153,0)
S PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1)
Q:((PSGRF<2)!($G(PSGST)="O")!($G(PSGST)="P")!($G(PSGST)="OC")) ; no removal flag or no removal
rotation
"RTN","PSGOE81",154,0)
Q:$G(PSGS0XT)>1440 ; Duration of Administration valid only for 24 hours - subject to change in future.
"RTN","PSGOE81",155,0)
N RP,PSGIDF,WMSG,PSGDERR S (PSGIDF,PSGDERR)=0 S:$G(PSGDUR)>0 RP=(PSGDUR/60)
S:"BID,TID,QID"[$G(PSGSCH) PSGIDF=1 ; Use separate validation for Times per day type orders
"RTN","PSGOE81",156,0)
S PSGF2=39
"RTN","PSGOE81",157,0)
W !,"DURATION OF ADMINISTRATION (HRS): "_$S($G(RP):RP_"// ",1:"") R RP:DTIME I RP="^"!'$T W:'$T
$C(7) S PSGDUR=$G(PSGDOA),X="^",PSGOEE=0 Q
"RTN","PSGOE81",158,0)
I RP="" S:$G(PSGDUR)>0 RP=($G(PSGDUR)/60)
"RTN","PSGOE81",159,0)
I RP="",$G(PSGS0XT)="D",$L(PSGSCH,"@")=2,$P(PSGSCH,"@",2) S
(PSGAT,PSGRMVT)=$P(PSGSCH,"@",2) G 8
"RTN","PSGOE81",160,0)
I RP="@",PSGRF'=3 D DEL G:%'=1 PSGDUR S (PSGS0Y,PSGDUR,PSGRMVT)="",PSGRMV=-1
S:+$G(^PS(53.1,+$G(PSGORD),2.1)) (PSGDUR,PSGRMV,PSGRMVT)="@" Q
"RTN","PSGOE81",161,0)
I (RP'=""),(RP'="@"),($E(RP)'="^"),($E(RP)'="?") S:(RP'?1N.2N)!(+(RP)<1) RP="?"
"RTN","PSGOE81",162,0)
I RP?1."?" D DURHLP^PSGOEM(RP,PSGRF) G PSGDUR
"RTN","PSGOE81",163,0)
I $E(RP)="^" D FF G:Y>0 @Y G PSGDUR
"RTN","PSGOE81",164,0)
I (+RP>0),'PSGIDF D ; exclude BID,TID or QID schedules
"RTN","PSGOE81",165,0)
. S PSGDUR=(RP*60),PSGRMV=$G(PSGS0XT)-PSGDUR
"RTN","PSGOE81",166,0)
. I PSGRMV<1 W !,"DURATION OF ADMINISTRATION MATCHES OR EXCEEDS ORDER FREQUENCY" S
RP="",PSGDERR=1 K PSGDUR,PSGRMV G PSGDUR
"RTN","PSGOE81",167,0)
.Q
"RTN","PSGOE81",168,0)
Q:$G(PSGDERR)=1
"RTN","PSGOE81",169,0)
I PSGRF=3,(+RP<1) W $C(7),!,"ENTRY IS REQUIRED" S RP="" G PSGDUR
"RTN","PSGOE81",170,0)
I PSGRF=2,(+RP<1) D
"RTN","PSGOE81",171,0)
. W !,"You have not entered Duration of Administration for this medication order, "
"RTN","PSGOE81",172,0)
. W !,"therefore the BCMA user will not be prompted to remove the medication prior "
"RTN","PSGOE81",173,0)
. W !,"to the next Admin Time."
"RTN","PSGOE81",174,0)
. S PSGRMV=-1,RP=0
"RTN","PSGOE81",175,0)
.Q
"RTN","PSGOE81",176,0)
I PSGIDF,(+RP>0) D ;Only for TPD schedules
"RTN","PSGOE81",177,0)
. N F,P,PSGARR
"RTN","PSGOE81",178,0)
. S PSGADT=$S($G(PSGDUR)=-1:X,$G(PSGAT):PSGAT,$G(PSGS0Y):PSGS0Y,1:""),PSGS0Y=PSGADT
"RTN","PSGOE81",179,0)
. S PSGARR=$L($G(PSGADT),"-")
"RTN","PSGOE81",180,0)
. F P=1:1:PSGARR D
"RTN","PSGOE81",181,0)
.. S PSGARR(P)=($P(PSGADT,"-",P)/100) S:(P>1) F(P)=PSGARR(P)-PSGARR(P-1)
"RTN","PSGOE81",182,0)
.. I $G(F(P)),($G(F(P))'=RP) S WMSG=1_U_"Duration of Administration does not correspond to one or
more",WMSG(1)="of this order's scheduled Administration Times!"
"RTN","PSGOE81",183,0)
..Q
"RTN","PSGOE81",184,0)
.Q
"RTN","PSGOE81",185,0)
S:(+RP>0) PSGDUR=(RP*60)
"RTN","PSGOE81",186,0)
W:(+RP>0) ?60,RP," HOURS"
"RTN","PSGOE81",187,0)
D:$G(WMSG) EN^DDIOL($P(WMSG,U,2)),EN^DDIOL(WMSG(1))
"RTN","PSGOE81",188,0)
Q
"RTN","PSGOE81",189,0)
;
"RTN","PSGOE81",190,0)
VERTIMES ; Redisplay Admin and Removal times
"RTN","PSGOE81",191,0)
S PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1) Q:(PSGRF<2)!($G(PSGST)="O")
"RTN","PSGOE81",192,0)
N PSGADT,PSGRARR,PSGAARR
"RTN","PSGOE81",193,0)
;If we have a frequency and this is odd type order then we need to start calculations with order start
time.
"RTN","PSGOE81",194,0)
I $G(PSGS0XT),$G(PSGNESD),+$G(PSGDUR),$G(PSGAT)="" D Q
"RTN","PSGOE81",195,0)
. N L
"RTN","PSGOE81",196,0)
. S (PSGAARR,PSGRARR)=1,PSGADT=$P($P(PSGNESD,U,1),".",2),L=$L(PSGADT)
"RTN","PSGOE81",197,0)
. S PSGRARR(1)=(((((PSGADT*60)+PSGDUR)/60)#24)*100) S:PSGRARR(1)=0 PSGRARR(1)=2400
S:$L(PSGRARR(1))=3 PSGRARR(1)="0"_PSGRARR(1)
"RTN","PSGOE81",198,0)
. S PSGRARR(1)=$E(PSGRARR(1),1,L)_"(R)"
"RTN","PSGOE81",199,0)
. S PSGAARR(1)=PSGADT,PSGAARR(1)=$E(PSGAARR(1),1,L)_"(A)"
"RTN","PSGOE81",200,0)
. D WRITE
"RTN","PSGOE81",201,0)
.Q
"RTN","PSGOE81",202,0)
;
"RTN","PSGOE81",203,0)
S (PSGRARR,PSGAARR)=$S($G(PSGAT):$L(PSGAT,"-"),1:$L(PSGS0Y,"-"))
"RTN","PSGOE81",204,0)
N P,L
"RTN","PSGOE81",205,0)
F P=1:1:PSGRARR D
"RTN","PSGOE81",206,0)
. S PSGADT=$S($G(PSGAT):$P(PSGAT,"-",P),1:$P(PSGS0Y,"-",P)),L=$L(PSGADT)
"RTN","PSGOE81",207,0)
. S PSGADT=$S($L(PSGADT)=4:PSGADT/100,1:PSGADT*1)
"RTN","PSGOE81",208,0)
. S PSGRARR(P)=(((((PSGADT*60)+PSGDUR)/60)#24)*100) S:PSGRARR(P)=0 PSGRARR(P)=2400
S:$L(PSGRARR(P))=3 PSGRARR(P)="0"_PSGRARR(P)
"RTN","PSGOE81",209,0)
. S PSGRARR(P)=$E(PSGRARR(P),1,L)_"(R)"
"RTN","PSGOE81",210,0)
. S PSGAARR(P)=(PSGADT*100) S:$L(PSGAARR(P))=3 PSGAARR(P)="0"_PSGAARR(P)
"RTN","PSGOE81",211,0)
. S PSGAARR(P)=$E(PSGAARR(P),1,L)_"(A)"
"RTN","PSGOE81",212,0)
.Q
"RTN","PSGOE81",213,0)
D WRITE
"RTN","PSGOE81",214,0)
Q
"RTN","PSGOE81",215,0)
;
"RTN","PSGOE81",216,0)
WRITE ;
"RTN","PSGOE81",217,0)
W !!,"Verify Admin and removal times",!
"RTN","PSGOE81",218,0)
W !,"(A)DMINISTRATION -(R)EMOVAL TIMES"
"RTN","PSGOE81",219,0)
W !,"___________________________________________________________________________",!
"RTN","PSGOE81",220,0)
F P=1:1:PSGAARR W PSGAARR(P)_"-"_PSGRARR(P) W:P'=PSGAARR " , "
"RTN","PSGOE81",221,0)
D ASK
"RTN","PSGOE81",222,0)
Q
"RTN","PSGOE81",223,0)
;
"RTN","PSGOE81",224,0)
ASK ;
"RTN","PSGOE81",225,0)
N Y
"RTN","PSGOE81",226,0)
S DIR("A")="Is this correct",DIR(0)="Y" D ^DIR I $D(DUOUT)!$D(DTOUT) W:'$T $C(7) S PSGOEE=0 K
PSGDUR G DONE
"RTN","PSGOE81",227,0)
I 'Y K X S PSGDUR=-1 G A39
"RTN","PSGOE81",228,0)
N P S P=1,PSGRMVT=$P(PSGRARR(P),"(",1)
"RTN","PSGOE81",229,0)
F S P=$O(PSGRARR(P)) Q:P="" D
"RTN","PSGOE81",230,0)
. S PSGRMVT=PSGRMVT_"-"_$P(PSGRARR(P),"(",1)
"RTN","PSGOE81",231,0)
.Q
"RTN","PSGOE81",232,0)
Q
"RTN","PSGOE81",233,0)
;
"RTN","PSGOE91")
0^4^B121528275^B121527756
"RTN","PSGOE91",1,0)
PSGOE91 ;BIR/CML3 - ACTIVE ORDER EDIT (CONT.) ;Jul 02, 2018@09:13
"RTN","PSGOE91",2,0)
;;5.0;INPATIENT MEDICATIONS;**50,64,58,110,111,136,113,179,265,267,285,315,334,373**;16 DEC
97;Build 3
"RTN","PSGOE91",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","PSGOE91",4,0)
; Reference to ^PS(55 is supported by DBIA #2191.
"RTN","PSGOE91",5,0)
; Reference to ^PS(50.7 is supported by DBIA# 2180
"RTN","PSGOE91",6,0)
; Reference to ^PS(51.1 is supported by DBIA 2177.
"RTN","PSGOE91",7,0)
;
"RTN","PSGOE91",8,0)
41 ; admin times
"RTN","PSGOE91",9,0)
;S MSG=0,PSGF2=41,ORIG=$G(PSGAT) S:PSGOEEF(PSGF2) BACK="41^PSGOE91"
"RTN","PSGOE91",10,0)
;*315 next 5 lines
"RTN","PSGOE91",11,0)
N PSGDOA
"RTN","PSGOE91",12,0)
S MSG=0,PSGF2=41,ORIG=$G(PSGAT),PSGDOA=$G(PSGDUR) S:PSGOEEF(PSGF2) BACK="41^PSGOE91"
"RTN","PSGOE91",13,0)
I (PSGST="P")!$$PRNOK^PSGS0($G(PSGSCH)) G DONE
"RTN","PSGOE91",14,0)
I $$ODD^PSGS0(PSGS0XT) D PSGDUR G DONE
"RTN","PSGOE91",15,0)
A41 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
"RTN","PSGOE91",16,0)
. W !!?5,"ADMIN TIMES may not be edited for active complex orders." D PAUSE^VALM1
"RTN","PSGOE91",17,0)
W !,"ADMIN TIMES: "_$S(PSGAT:PSGAT_"// ",1:"") R X:DTIME I X="^"!('$T) W:'$T $C(7) S PSGOEE=0
S:X="^" (X,PSGAT)=$G(ORIG),PSGDUR="" G DONE
"RTN","PSGOE91",18,0)
I X="" S:$G(PSGAT) X=PSGAT,PSGNOHI=1 ;*315 If admin time default was taken then don't highlight
admin time.
"RTN","PSGOE91",19,0)
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A41
"RTN","PSGOE91",20,0)
I X="@" I (PSGS0XT="D")!(PSGSCH["@") I ((",P,R,OC,O,")'[(","_$G(PSGST)_",")) D G A41
"RTN","PSGOE91",21,0)
.W $C(7)," ??" S X="?" W:PSGS0XT="D"!(PSGSCH["@") !,"This is a 'DAY OF THE WEEK' schedule and
MUST have admin times." D ENHLP^PSGOEM(55.06,41)
"RTN","PSGOE91",22,0)
I X="@" D DEL G:%'=1 A41 S PSGAT="",X=""
"RTN","PSGOE91",23,0)
I
((PSGST="O")!($G(PSGST)="OC")!($G(PSGST)="P")!$$ODD^PSGS0($P($G(ZZND),"^",3))!($P($G(ZZND),"^"
,5)="O")),X="" D G DONE
"RTN","PSGOE91",24,0)
. S (PSGS0Y,PSGAT)=X
"RTN","PSGOE91",25,0)
. I (($G(PSGRF))&($G(PSGST)="O")) N PSGRO S PSGOEEF(34)=1,PSGOEEF(41)=1,PSGRO=1 D 34
"RTN","PSGOE91",26,0)
.Q
"RTN","PSGOE91",27,0)
I $G(PSGS0XT) I '$$ODD^PSGS0(PSGS0XT),$G(PSGST)'="P",$G(PSGST)'="OC",'$$PRNOK^PSGS0(PSGSCH)
I ($G(PSGST)'="O") D TIMES G:'$D(X) A41 D PSGDUR G:'$D(X) A41 G:$G(X)="^" DONE ;*315
"RTN","PSGOE91",28,0)
I X?1."?" D ENHLP^PSGOEM(55.06,41) G A41
"RTN","PSGOE91",29,0)
D ENCHK^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,41) G A41
"RTN","PSGOE91",30,0)
S PSGOAT=PSGAT
"RTN","PSGOE91",31,0)
S (PSGS0Y,PSGAT)=X G DONE
"RTN","PSGOE91",32,0)
;
"RTN","PSGOE91",33,0)
8 ; special instructions
"RTN","PSGOE91",34,0)
S MSG=0,PSGF2=8 S:PSGOEEF(PSGF2) BACK="8^PSGOE91"
"RTN","PSGOE91",35,0)
A8 I $G(PSGP),$G(PSGORD) I $$COMPLEX^PSJOE(PSGP,PSGORD) D
"RTN","PSGOE91",36,0)
. N X,Y,PARENT,P2ND S
P2ND=$S(PSGORD["U":$G(^PS(55,PSGP,5,+PSGORD,.2)),1:$G(^PS(53.1,+PSGORD,.2))),PARENT=$P(P2ND
,"^",8)
"RTN","PSGOE91",37,0)
. I PARENT D FULL^VALM1 W !!?5,"This order is part of a complex order. Please review the following
",!?5,"associated orders before changing this order." D CMPLX^PSJCOM1(PSGP,PARENT,PSGORD)
"RTN","PSGOE91",38,0)
I $E(X)=U D ENFF^PSGOE92 G:Y>0 @Y G A8
"RTN","PSGOE91",39,0)
S PSGSI=$$EDITSI^PSJBCMA5($G(PSGP),$G(PSGORD)) I $G(PSGP),$G(PSGORD) I
'$$DIFFSI^PSJBCMA5(PSGP,PSGORD) S PSGOEE=0 G DONE
"RTN","PSGOE91",40,0)
S PSGSI=$S((PSGSI>0&(PSGSI<4)):$G(^PS(53.45,+PSJSYSP,5,1,0))_"
"_$G(^PS(53.45,+PSJSYSP,5,2,0)),PSGSI>3:"Instructions too long. See Order View or BCMA for full
text.",1:"")
"RTN","PSGOE91",41,0)
S:PSGSI=" " PSGSI="" I PSGSI]"" S PSGSI=$$ENBCMA^PSJUTL("U") G DONE
"RTN","PSGOE91",42,0)
Q
"RTN","PSGOE91",43,0)
;
"RTN","PSGOE91",44,0)
10 ; start date/time
"RTN","PSGOE91",45,0)
S MSG=0,PSGF2=10 S:PSGOEEF(PSGF2) BACK="10^PSGOE91"
"RTN","PSGOE91",46,0)
A10 ;
"RTN","PSGOE91",47,0)
I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
"RTN","PSGOE91",48,0)
. W !!?5,"Start Date/Time may not be edited for active complex orders." D PAUSE^VALM1
"RTN","PSGOE91",49,0)
K PSGSDX
"RTN","PSGOE91",50,0)
W !,"START DATE/TIME: "_$S($P(PSGSDN,"^")]"":$P(PSGSDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T
W:'$T $C(7) S PSGOEE=0 G DONE
"RTN","PSGOE91",51,0)
I X="",PSGSD W " "_PSGSDN G DONE
"RTN","PSGOE91",52,0)
;I X="P" D ENPREV^PSGDL W:'$D(X) $C(7) G:'$D(X) A10 S
PSGSD=+X,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD) W " ",$P(PSGSDN,"^") G
DONE ;373
"RTN","PSGOE91",53,0)
I X="P" D ENPREV^PSGDL W:'$D(X) $C(7) G:'$D(X) A10 S
PSGSD=+X,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC2^PSGMI(PSGSD) W " ",$P(PSGSDN,"^") G
DONE ;373
"RTN","PSGOE91",54,0)
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,10)
"RTN","PSGOE91",55,0)
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A10
"RTN","PSGOE91",56,0)
NEW TMPX S TMPX=X,X1=PSGDT,X2=-7 D C^%DTC K %DT S %DT="ERTX",%DT(0)=X,X=TMPX D ^%DT K
%DT I Y'>0 D ENHLP^PSGOEM(55.06,10) G A10
"RTN","PSGOE91",57,0)
I PSGFD<Y W $C(7),!?5,"*** THE START DATE CANNOT BE AFTER THE STOP DATE! ***",! S MSG=1 G A10
"RTN","PSGOE91",58,0)
; RBD PSJ*5*373 Soft stop when Start Date more than 7 days after Order's LOGIN DATE
"RTN","PSGOE91",59,0)
S X1=+$G(PSGDT),X2=+7 D C^%DTC
"RTN","PSGOE91",60,0)
I +Y>X W !!,$C(7),"Start date/time should not be entered for more than 7 days after the",!,"order's
LOGIN DATE.",! K DIR D WAIT^VALM1
"RTN","PSGOE91",61,0)
;S (PSGSDX,PSGSD)=+Y,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD) G DONE ;373
"RTN","PSGOE91",62,0)
S (PSGSDX,PSGSD)=+Y,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC2^PSGMI(PSGSD) G DONE ;373
"RTN","PSGOE91",63,0)
;
"RTN","PSGOE91",64,0)
34 ; stop date
"RTN","PSGOE91",65,0)
S MSG=0,PSGF2=34 S:PSGOEEF(PSGF2) BACK="34^PSGOE91"
"RTN","PSGOE91",66,0)
A34 ;
"RTN","PSGOE91",67,0)
K PSGFDX
"RTN","PSGOE91",68,0)
I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
"RTN","PSGOE91",69,0)
. W !!?5,"Stop Date/Time may not be edited for active complex orders." D PAUSE^VALM1
"RTN","PSGOE91",70,0)
N MSG,PSGTMPST S PSGTMPST=$G(PSGST) S:'+$G(PSGRF)
PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1) ;*315 One time orders for MRR's require message to
instruct pharmacists
"RTN","PSGOE91",71,0)
I +$G(PSGRF),$D(^PS(51.1,"AC","PSJ",$G(PSGSCH))) D
"RTN","PSGOE91",72,0)
. S:PSGTMPST=($G(PSGST)="R")
PSGST=$P($G(^PS(51.1,$O(^PS(51.1,"AC","PSJ",$G(PSGSCH),"")),0)),"^",5) ;Handle "Fill on Request"
"RTN","PSGOE91",73,0)
.Q
"RTN","PSGOE91",74,0)
I $G(PSGTMPST)="O",+$G(PSGRF) S (PSGFDN,PSGFD)="" D
"RTN","PSGOE91",75,0)
. I +$G(PSGRF)=1 S MSG(1)="This NOW order has an Orderable Item for which a removal is required" D
"RTN","PSGOE91",76,0)
.. S MSG(2)=" at the next administration."
"RTN","PSGOE91",77,0)
.. S MSG(3)="The Stop DATE/TIME entered should be the next anticipated administration for the
medication.",MSG(3,"F")="!"
"RTN","PSGOE91",78,0)
..Q
"RTN","PSGOE91",79,0)
. I +$G(PSGRF)=2 S MSG(1)="This NOW order has an Orderable Item for which a removal period is
optional",MSG(1,"F")="!!" D
"RTN","PSGOE91",80,0)
.. S MSG(2)="prior to the next administration.",MSG(2,"F")="!"
"RTN","PSGOE91",81,0)
.. S MSG(3)="If Early Removal is needed, enter Removal Time in Stop DATE/TIME field.",MSG(3,"F")="!"
"RTN","PSGOE91",82,0)
.. S MSG(4)="If an Early Removal is not required, the Stop DATE/TIME entered"
"RTN","PSGOE91",83,0)
.. S MSG(5)="should be the next anticipated administration for the medication.",MSG(5,"F")="!"
"RTN","PSGOE91",84,0)
..Q
"RTN","PSGOE91",85,0)
. I +$G(PSGRF)=3 S MSG(1)="This NOW order has an Orderable Item that requires a removal period
prior",MSG(1,"F")="!!" D
"RTN","PSGOE91",86,0)
.. S MSG(2)=" to the next administration.",MSG(2,"F")="!"
"RTN","PSGOE91",87,0)
.. S MSG(3)="Please Enter the Stop DATE/TIME to reflect the Removal Time for this
medication.",MSG(3,"F")="!"
"RTN","PSGOE91",88,0)
..Q
"RTN","PSGOE91",89,0)
. D EN^DDIOL(.MSG)
"RTN","PSGOE91",90,0)
.Q
"RTN","PSGOE91",91,0)
W !,"STOP DATE/TIME: "_$S($P(PSGFDN,"^")]"":$P(PSGFDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T
$C(7) S PSGOEE=0 G DONE
"RTN","PSGOE91",92,0)
I X="",PSGFD W " "_$P(PSGFDN,"^") G W34
"RTN","PSGOE91",93,0)
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A34
"RTN","PSGOE91",94,0)
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,34)
"RTN","PSGOE91",95,0)
I X=+X,(X>0),(X'>2000000) G A34:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X W " ...dose limit..." D
ENE^PSGDL
"RTN","PSGOE91",96,0)
K %DT S %DT="ERTX",%DT(0)=PSGSD D ^%DT K %DT I Y'>0 W $C(7),!!?13,"*** WARNING! INVALID STOP
DATE OR PRIOR TO START DATE! ***",! G A34
"RTN","PSGOE91",97,0)
; RBD PSJ*5*373 Hard stop when Stop Date more than 367 days after Start Date
"RTN","PSGOE91",98,0)
S X1=+Y,X2=PSGSD D ^%DTC
"RTN","PSGOE91",99,0)
I X>367 W $C(7),!!?13,"*** STOP DATE cannot be more than 367 days from START DATE ***",! G A34
"RTN","PSGOE91",100,0)
;S (PSGFDX,PSGFD)=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD) ;373
"RTN","PSGOE91",101,0)
S (PSGFDX,PSGFD)=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC2^PSGMI(PSGFD) ;373
"RTN","PSGOE91",102,0)
W34 ;Compare to Start Date
"RTN","PSGOE91",103,0)
N Z,MSG
"RTN","PSGOE91",104,0)
D DOSE I $G(Z)]"",Z>$S($G(PSGFD):PSGFD,1:$G(PSGNEFD)) D G A34
"RTN","PSGOE91",105,0)
. S MSG(1)="There is no administration time that falls between the Start Date/Time"
"RTN","PSGOE91",106,0)
. S MSG(2)="and the Stop Date/Time."
"RTN","PSGOE91",107,0)
. D EN^DDIOL(.MSG)
"RTN","PSGOE91",108,0)
I PSGFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",! S
MSG=1
"RTN","PSGOE91",109,0)
Q:+$G(PSGRO)
"RTN","PSGOE91",110,0)
;
"RTN","PSGOE91",111,0)
DONE ;
"RTN","PSGOE91",112,0)
;Display Expected First Dose;BHW;PSJ*5*136
"RTN","PSGOE91",113,0)
;BHW;PSJ*5*179; - Remove EFD call. Added to PSGOEE.
"RTN","PSGOE91",114,0)
I PSGOEE G:'PSGOEEF(PSGF2) @BACK S PSGOEE=PSGOEEF(PSGF2)
"RTN","PSGOE91",115,0)
D:+$G(PSGDUR) VERTIMES ;*315
"RTN","PSGOE91",116,0)
S:'+$G(PSGRF) PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1)
"RTN","PSGOE91",117,0)
K F,F0,F1,PSGF2,F3,PSG,SDT,ORIG Q
"RTN","PSGOE91",118,0)
;
"RTN","PSGOE91",119,0)
FF ; up-arrow to another field
"RTN","PSGOE91",120,0)
D ENFF^PSGOEM I Y>0,Y'=41,Y'=8,Y'=10,Y'=34 S
Y=Y_"^PSGOE9"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2) S:Y=2 FB=PSGF2_"^PSGOE91"
"RTN","PSGOE91",121,0)
Q
"RTN","PSGOE91",122,0)
;
"RTN","PSGOE91",123,0)
DEL ; delete entry
"RTN","PSGOE91",124,0)
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
"RTN","PSGOE91",125,0)
Q
"RTN","PSGOE91",126,0)
;
"RTN","PSGOE91",127,0)
TIMES ;At least one admin time, not more than interval allows.
"RTN","PSGOE91",128,0)
I $G(PSGST)'="O",($G(PSGST)'="OC"),($G(PSGST)'="R") I X="" D EN^DDIOL("This order requires at least
one administration time.") K X Q ;No times
"RTN","PSGOE91",129,0)
N H,I,MAX
"RTN","PSGOE91",130,0)
I PSGSCH]"" I $D(^PS(51.1,"AC","PSJ",PSGSCH)) S H=+$O(^PS(51.1,"AC","PSJ",PSGSCH,0)) S
I=$P($G(^PS(51.1,H,0)),"^",3)
"RTN","PSGOE91",131,0)
I $G(PSGST)="O",$L(X,"-")>1 D EN^DDIOL("This is a One Time Order. Only one administration time is
permitted.") K X Q
"RTN","PSGOE91",132,0)
I $G(PSGST)="O" Q ;Done validating One Time
"RTN","PSGOE91",133,0)
I +$G(I)=0 Q ;No frequency - can not check frequency related items
"RTN","PSGOE91",134,0)
S MAX=1440/I
"RTN","PSGOE91",135,0)
I MAX<1,$L(X,"-")>1 D EN^DDIOL("This order requires one administration time.") K X Q
"RTN","PSGOE91",136,0)
I MAX'<1,$L(X,"-")>MAX D EN^DDIOL("The number of admin times entered is greater than indicated by
the schedule.") K X Q ;Too many times
"RTN","PSGOE91",137,0)
I MAX'<1,$L(X,"-")<MAX D EN^DDIOL("The number of admin times entered is fewer than indicated by
the schedule.") ;Too few times
"RTN","PSGOE91",138,0)
Q
"RTN","PSGOE91",139,0)
;
"RTN","PSGOE91",140,0)
DOSE ;Make certain at least one dose is given.
"RTN","PSGOE91",141,0)
N INFO,X
"RTN","PSGOE91",142,0)
S
Z="",INFO=($S($G(PSGSD):PSGSD,1:$G(PSGNESD)))_U_($S($G(PSGFD):PSGFD,1:$G(PSGNEFD)))_U_($G(P
SGSCH))_U_($G(PSGST))_U_($G(PSGDRG))_U_($G(PSGS0Y))
"RTN","PSGOE91",143,0)
Q:$G(PSGST)="OC"!($G(PSGST)="P")
"RTN","PSGOE91",144,0)
I '$L($G(PSGP)) N PSGP S PSGP=""
"RTN","PSGOE91",145,0)
S Z=$$ENQ^PSJORP2(PSGP,INFO) ;Expected first dose.
"RTN","PSGOE91",146,0)
Q
"RTN","PSGOE91",147,0)
;*315 New tags
"RTN","PSGOE91",148,0)
PSGDUR ; Prompt for Removal times if admin times are on 24hr rotations and Site Params are enabled.
"RTN","PSGOE91",149,0)
; check parameter files for removal criteria quit if removal rotation not enabled (<2)
"RTN","PSGOE91",150,0)
; if enabled determine type (hard vers soft stop)
"RTN","PSGOE91",151,0)
;0 = no removal (current cap/tab functionality)
"RTN","PSGOE91",152,0)
;1 = removal at next admin (current patch functionality)
"RTN","PSGOE91",153,0)
;2 = removal prior to next admin; soft stop (pharmacist optional prompt to designate duration of
administration
"RTN","PSGOE91",154,0)
;3 = removal prior to next admin; hard stop (pharmacist required prompt to designate duration of
administration)
"RTN","PSGOE91",155,0)
; prompt for removal if = 2 then allow skip, if = 3 then force entry
"RTN","PSGOE91",156,0)
;
"RTN","PSGOE91",157,0)
S PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1)
Q:((PSGRF<2)!($G(PSGST)="O")!($G(PSGST)="P")!($G(PSGST)="OC")) ; no removal flag or no removal
rotation
"RTN","PSGOE91",158,0)
Q:$G(PSGS0XT)>1440 ; Duration of Administration valid only for 24 hours - subject to change in future.
"RTN","PSGOE91",159,0)
N RP,PSGIDF,WMSG,PSGDERR S (PSGIDF,PSGDERR)=0 S:$G(PSGDUR)>0 RP=(PSGDUR/60)
S:"BID,TID,QID"[$G(PSGSCH) PSGIDF=1 ; Use separate validation for Times per day type orders
"RTN","PSGOE91",160,0)
S PSGF2=41
"RTN","PSGOE91",161,0)
W !,"DURATION OF ADMINISTRATION (HRS): "_$S($G(RP):RP_"// ",1:"") R RP:DTIME I RP="^"!'$T W:'$T
$C(7) S PSGDUR=$G(PSGDOA),X="^",PSGOEE=0 Q
"RTN","PSGOE91",162,0)
I RP="" S:$G(PSGDUR)>0 RP=($G(PSGDUR)/60)
"RTN","PSGOE91",163,0)
I RP="",$G(PSGS0XT)="D",$L(PSGSCH,"@")=2,$P(PSGSCH,"@",2) S
(PSGAT,PSGRMVT)=$P(PSGSCH,"@",2) G 8
"RTN","PSGOE91",164,0)
I RP="@",PSGRF'=3 D DEL G:%'=1 PSGDUR S PSGS0Y="",(PSGDUR,PSGRMVT)="@",PSGRMV=-1 Q
"RTN","PSGOE91",165,0)
I (RP'=""),(RP'="@"),($E(RP)'="^"),($E(RP)'="?") S:(RP'?1N.2N)!(+(RP)<1) RP="?"
"RTN","PSGOE91",166,0)
I RP?1."?" D DURHLP^PSGOEM(RP,PSGRF) G PSGDUR
"RTN","PSGOE91",167,0)
I $E(RP)="^" D FF G:Y>0 @Y G PSGDUR
"RTN","PSGOE91",168,0)
I (+RP>0),'PSGIDF D ; exclude BID,TID or QID schedules
"RTN","PSGOE91",169,0)
. S PSGDUR=(RP*60),PSGRMV=$G(PSGS0XT)-PSGDUR
"RTN","PSGOE91",170,0)
. I PSGRMV<1 W !,"DURATION OF ADMINISTRATION MATCHES OR EXCEEDS ORDER FREQUENCY" S
RP="",PSGDERR=1 K PSGDUR,PSGRMV G PSGDUR Q
"RTN","PSGOE91",171,0)
.Q
"RTN","PSGOE91",172,0)
Q:$G(PSGDERR)=1
"RTN","PSGOE91",173,0)
I PSGRF=3,(+RP<1) W $C(7),!,"ENTRY IS REQUIRED" S RP="" G PSGDUR
"RTN","PSGOE91",174,0)
I PSGRF=2,(+RP<1) D
"RTN","PSGOE91",175,0)
. W !,"You have not entered Duration of Administration for this medication order, "
"RTN","PSGOE91",176,0)
. W !,"therefore the BCMA user will not be prompted to remove the medication prior "
"RTN","PSGOE91",177,0)
. W !,"to the next Admin Time."
"RTN","PSGOE91",178,0)
. S PSGRMV=-1,RP=0
"RTN","PSGOE91",179,0)
.Q
"RTN","PSGOE91",180,0)
I PSGIDF,(+RP>0) D ;Only for TPD schedules
"RTN","PSGOE91",181,0)
. N F,P,PSGARR
"RTN","PSGOE91",182,0)
. S PSGADT=$S($G(PSGDUR)=-1:X,$G(PSGS0Y):PSGS0Y,$G(PSGAT):PSGAT,1:""),PSGS0Y=PSGADT
"RTN","PSGOE91",183,0)
. S PSGARR=$L($G(PSGADT),"-")
"RTN","PSGOE91",184,0)
. F P=1:1:PSGARR D
"RTN","PSGOE91",185,0)
.. S PSGARR(P)=($P(PSGADT,"-",P)/100) S:(P>1) F(P)=PSGARR(P)-PSGARR(P-1)
"RTN","PSGOE91",186,0)
.. I $G(F(P)),($G(F(P))'=RP) S WMSG=1_U_"Duration of Administration does not correspond to one or
more",WMSG(1)="of this order's scheduled Administration Times!"
"RTN","PSGOE91",187,0)
..Q
"RTN","PSGOE91",188,0)
.Q
"RTN","PSGOE91",189,0)
S:(+RP>0) PSGDUR=(RP*60)
"RTN","PSGOE91",190,0)
W:(+RP>0) ?60,RP," HOURS"
"RTN","PSGOE91",191,0)
D:$G(WMSG) EN^DDIOL($P(WMSG,U,2)),EN^DDIOL(WMSG(1))
"RTN","PSGOE91",192,0)
Q
"RTN","PSGOE91",193,0)
;
"RTN","PSGOE91",194,0)
VERTIMES ; Redisplay Admin and Removal times *315
"RTN","PSGOE91",195,0)
S PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1) Q:(PSGRF<2)!($G(PSGST)="O")
"RTN","PSGOE91",196,0)
N PSGADT,PSGRARR,PSGAARR
"RTN","PSGOE91",197,0)
;If we have a frequency and this is odd type order then we need to start calculations with order start
time.
"RTN","PSGOE91",198,0)
I $G(PSGS0XT),$G(PSGNESD),+$G(PSGDUR),$G(PSGAT)="" D Q
"RTN","PSGOE91",199,0)
. N L
"RTN","PSGOE91",200,0)
. S (PSGAARR,PSGRARR)=1,PSGADT=$P($P(PSGNESD,U,1),".",2),L=$L(PSGADT)
"RTN","PSGOE91",201,0)
. S PSGRARR(1)=(((((PSGADT*60)+PSGDUR)/60)#24)*100) S:PSGRARR(1)=0 PSGRARR(1)=2400
S:$L(PSGRARR(1))=3 PSGRARR(1)="0"_PSGRARR(1)
"RTN","PSGOE91",202,0)
. S PSGRARR(1)=$E(PSGRARR(1),1,L)_"(R)"
"RTN","PSGOE91",203,0)
. S PSGAARR(1)=PSGADT,PSGAARR(1)=$E(PSGAARR(1),1,L)_"(A)"
"RTN","PSGOE91",204,0)
. D WRITE
"RTN","PSGOE91",205,0)
.Q
"RTN","PSGOE91",206,0)
;
"RTN","PSGOE91",207,0)
S (PSGRARR,PSGAARR)=$S($G(PSGAT):$L(PSGAT,"-"),1:$L(PSGS0Y,"-"))
"RTN","PSGOE91",208,0)
N P,L
"RTN","PSGOE91",209,0)
F P=1:1:PSGRARR D
"RTN","PSGOE91",210,0)
. S PSGADT=$S($G(PSGAT):$P(PSGAT,"-",P),1:$P(PSGS0Y,"-",P)),L=$L(PSGADT)
"RTN","PSGOE91",211,0)
. S PSGADT=$S($L(PSGADT)=4:PSGADT/100,1:PSGADT*1)
"RTN","PSGOE91",212,0)
. S PSGRARR(P)=(((((PSGADT*60)+PSGDUR)/60)#24)*100) S:PSGRARR(P)=0 PSGRARR(P)=2400
S:$L(PSGRARR(P))=3 PSGRARR(P)="0"_PSGRARR(P)
"RTN","PSGOE91",213,0)
. S PSGRARR(P)=$E(PSGRARR(P),1,L)_"(R)"
"RTN","PSGOE91",214,0)
. S PSGAARR(P)=(PSGADT*100) S:$L(PSGAARR(P))=3 PSGAARR(P)="0"_PSGAARR(P)
"RTN","PSGOE91",215,0)
. S PSGAARR(P)=$E(PSGAARR(P),1,L)_"(A)"
"RTN","PSGOE91",216,0)
.Q
"RTN","PSGOE91",217,0)
D WRITE
"RTN","PSGOE91",218,0)
Q
"RTN","PSGOE91",219,0)
;
"RTN","PSGOE91",220,0)
WRITE ;
"RTN","PSGOE91",221,0)
W !!,"Verify Admin and removal times",!
"RTN","PSGOE91",222,0)
W !,"(A)DMINISTRATION -(R)EMOVAL TIMES"
"RTN","PSGOE91",223,0)
W !,"___________________________________________________________________________",!
"RTN","PSGOE91",224,0)
F P=1:1:PSGAARR W PSGAARR(P)_"-"_PSGRARR(P) W:P'=PSGAARR " , "
"RTN","PSGOE91",225,0)
D ASK
"RTN","PSGOE91",226,0)
Q
"RTN","PSGOE91",227,0)
;
"RTN","PSGOE91",228,0)
ASK ;
"RTN","PSGOE91",229,0)
N Y
"RTN","PSGOE91",230,0)
S DIR("A")="Is this correct",DIR(0)="Y" D ^DIR I $D(DUOUT)!$D(DTOUT) W:'$T $C(7) S PSGOEE=0 K
PSGDUR G DONE
"RTN","PSGOE91",231,0)
I 'Y K X S PSGDUR=-1,PSGFOK(8)="" G A41
"RTN","PSGOE91",232,0)
N P S P=1,PSGRMVT=$P(PSGRARR(P),"(",1)
"RTN","PSGOE91",233,0)
F S P=$O(PSGRARR(P)) Q:P="" D
"RTN","PSGOE91",234,0)
. S PSGRMVT=PSGRMVT_"-"_$P(PSGRARR(P),"(",1)
"RTN","PSGOE91",235,0)
.Q
"RTN","PSGOE91",236,0)
Q
"RTN","PSGOE91",237,0)
;
"RTN","PSGOEE")
0^5^B107177603^B107176870
"RTN","PSGOEE",1,0)
PSGOEE ;BIR/CML3 - EDIT ACTIVE OR NON-VERIFIED ORDERS ;Jul 02, 2018@09:18
"RTN","PSGOEE",2,0)
;;5.0;INPATIENT
MEDICATIONS;**4,7,29,47,64,58,82,91,110,111,112,142,179,181,254,267,268,281,315,338,373**;16
DEC 97;Build 3
"RTN","PSGOEE",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","PSGOEE",4,0)
;
"RTN","PSGOEE",5,0)
; Reference to ^PS(55 is supported by DBIA# 2191.
"RTN","PSGOEE",6,0)
; Reference to ^PSSLOCK is supported by DBIA# 2789.
"RTN","PSGOEE",7,0)
; Reference to ^TMP("PSODAOC",$J is supported by DBIA# 6071.
"RTN","PSGOEE",8,0)
;
"RTN","PSGOEE",9,0)
D NOW^%DTC S PSGDT=% K PSGEFN,PSGOEEF S PSGOEEF=0 I PSGORD["A"!(PSGORD["O") G ACT
"RTN","PSGOEE",10,0)
531 ; edit orders in 53.1
"RTN","PSGOEE",11,0)
ENF ; Entry point
"RTN","PSGOEE",12,0)
D EN2^PSGOEEW
"RTN","PSGOEE",13,0)
K PSJACEPT D EDLOOP G:'$G(PSJACEPT) OUT
"RTN","PSGOEE",14,0)
I $G(PSGOEENO) D
"RTN","PSGOEE",15,0)
. N PSGOEENO S PSGOEENO=1 D NEW
"RTN","PSGOEE",16,0)
E D
"RTN","PSGOEE",17,0)
. N PSGOEENO S PSGOEENO=0 D UPD
"RTN","PSGOEE",18,0)
I $G(PSGOEAV) D ACT1 Q
"RTN","PSGOEE",19,0)
D DONE1
"RTN","PSGOEE",20,0)
S PSGOEEF=0,PSJORD=PSGORD D GETUD^PSJLMGUD(PSGP,PSGORD),ENSFE^PSGOEE0(PSGP,PSGORD)
"RTN","PSGOEE",21,0)
Q
"RTN","PSGOEE",22,0)
ACT ; Perform Edit
"RTN","PSGOEE",23,0)
NEW PSJALGY1
"RTN","PSGOEE",24,0)
K PSGOEER
"RTN","PSGOEE",25,0)
D EN2^PSGOEEW,EDLOOP G:'$G(PSJACEPT) OUT
"RTN","PSGOEE",26,0)
I $G(PSGOEENO) D
"RTN","PSGOEE",27,0)
. N PSGOEENO S PSGOEENO=1 D NEW
"RTN","PSGOEE",28,0)
E D
"RTN","PSGOEE",29,0)
. N PSGOEENO S PSGOEENO=0 D UPD
"RTN","PSGOEE",30,0)
S:$D(PSGOEF)!$G(PSGOEENO) PSGCANFL=-1
"RTN","PSGOEE",31,0)
ACT1 ; Continue editing
"RTN","PSGOEE",32,0)
D DONE1
"RTN","PSGOEE",33,0)
S PSGOEEF=0 D GETUD^PSJLMGUD(PSGP,PSGORD),ENSFE^PSGOEE0(PSGP,PSGORD) D:PSGOEAV
UNL^PSSLOCK(PSGP,PSGORD)
"RTN","PSGOEE",34,0)
Q
"RTN","PSGOEE",35,0)
EDIT ; Edit
"RTN","PSGOEE",36,0)
I $G(Y) D ASKOVR(Y,$G(PSGORD),.PSJSTARI)
"RTN","PSGOEE",37,0)
D FULL^VALM1
"RTN","PSGOEE",38,0)
W ! S PSGOEER="" F Q=1:1 S Q1=$P(Y,",",Q) Q:'Q1 S
X=$P($T(@(PSGOEEG_Q1)),";",3),PSGOEER=PSGOEER_X_";",PSGOEEF(+X)=Q S:Q1=1 PSJALGY1=1
"RTN","PSGOEE",39,0)
S LIMIT=$L(PSGOEER,";")-1,(PSGDEF,PSGOEE)=0 F S PSGOEE=PSGOEE+1 Q:PSGOEE>LIMIT I
+$P(PSGOEER,";",PSGOEE)=101 S PSGDEF=1
"RTN","PSGOEE",40,0)
S PSGOEER=$E(PSGOEER,1,$L(PSGOEER)-1),(MSG,PSGOEE)=0 F S PSGOEE=PSGOEE+1
Q:PSGOEE>$L(PSGOEER,";") S F1=$S(PSGOEEG=3:53.1,1:55.06) I
'PSGDEF!((PSGDEF)&(+$P(PSGOEER,";",PSGOEE)'=2)) D @$P(PSGOEER,";",PSGOEE) Q:'PSGOEE
"RTN","PSGOEE",41,0)
Q
"RTN","PSGOEE",42,0)
EDLOOP ; Continue prompting for fields to edit.
"RTN","PSGOEE",43,0)
K PSJNOO
"RTN","PSGOEE",44,0)
D:$G(Y) EDIT I $G(PSGOROE1)=1!($G(PSGOEE)=0) S VALMBCK="R",(PSGOROE1,PSJACEPT)=0 Q
"RTN","PSGOEE",45,0)
D ENNOU^PSGOEE0 I '$G(PSGOEENO),DR="" S VALMBCK="R" Q
"RTN","PSGOEE",46,0)
K VALMSG
"RTN","PSGOEE",47,0)
I '$G(PSGOEENO),$G(PSGPDNX) D CKDT
"RTN","PSGOEE",48,0)
I $G(PSGOEENO) D
"RTN","PSGOEE",49,0)
.S VALMSG="This change will cause a new order to be created." D GTSTATUS,CHKDD,CKDT
"RTN","PSGOEE",50,0)
.;S PSGEBN=$$ENNPN^PSGMI(DUZ),PSGLIN=$$ENDD^PSGMI(PSGDT)_U_$$ENDTC^PSGMI(PSGDT) ;373
"RTN","PSGOEE",51,0)
.S PSGEBN=$$ENNPN^PSGMI(DUZ),PSGLIN=$$ENDD^PSGMI(PSGDT)_U_$$ENDTC2^PSGMI(PSGDT)
;373
"RTN","PSGOEE",52,0)
D CHK^PSGOEV("^^"_PSGMR_"^^^^"_PSGST,PSGPDRG_U_PSGDO,PSGSCH_U_PSGSD_"^^"_PSGFD)
"RTN","PSGOEE",53,0)
K VALMBCK,PSJACEPT,PSGPDNX D EN^VALM("PSJU LM ACCEPT") Q:'$G(PSJACEPT)
"RTN","PSGOEE",54,0)
I $G(PSGS0XT)="D",'$G(PSGS0Y) I ((",P,R,")'[(","_$G(PSGST)_",")) D Q
"RTN","PSGOEE",55,0)
.S PSJACEPT=0 W !!,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." D
PAUSE^VALM1
"RTN","PSGOEE",56,0)
I
($G(PSGOEER)["26^PSGOE9")!($G(PSGOEER)["26^PSGOE8")!($G(PSGOEER)["109^PSGOE9")!($G(PSGOEE
R)["109^PSGOE8")!($G(PSGOEER)["3^PSGOE9")!($G(PSGOEER)["3^PSGOE8")!($G(PSGOEER)["101^PSGO
E9")!($G(PSGOEER)["101^PSGOE8") S PSGOEENO=1
"RTN","PSGOEE",57,0)
I $G(PSGOEENO)!($G(PSGOEER)["2^PSGOE92")!($G(PSGOEER)["2^PSGOE82") D OC
S:($G(PSGOEER)["2^PSGOE82") PSJDSVFY=1
"RTN","PSGOEE",58,0)
I $G(PSGORQF) S PSJNOO=-1
"RTN","PSGOEE",59,0)
I '$G(PSJNOO),$G(PSGOEENO) S PSJNOO=$$ENNOO^PSJUTL5("E")
"RTN","PSGOEE",60,0)
D K1 S PSJACEPT=$S($G(PSJNOO)<0:0,1:1)
"RTN","PSGOEE",61,0)
S VALMBCK=$S('PSJACEPT:"R",'PSGOEAV:"R",1:"Q")
"RTN","PSGOEE",62,0)
Q
"RTN","PSGOEE",63,0)
OC ;Perform OC (only when OI or Dosage was edited) & dosing check
"RTN","PSGOEE",64,0)
NEW PSJDD,PSJALLGY
"RTN","PSGOEE",65,0)
K PSGORQF
"RTN","PSGOEE",66,0)
D FULL^VALM1
"RTN","PSGOEE",67,0)
S PSJDD=+$$DD53P45^PSJMISC() I 'PSJDD S PSGORQF=1 Q
"RTN","PSGOEE",68,0)
I $G(PSJALGY1)!$G(PSGOEENO) D
"RTN","PSGOEE",69,0)
. D ENDDC^PSGSICHK(PSGP,PSJDD)
"RTN","PSGOEE",70,0)
D:'$G(PSGORQF) IN^PSJOCDS($G(PSGORD),"UD",PSJDD)
"RTN","PSGOEE",71,0)
Q
"RTN","PSGOEE",72,0)
CHKDD ;*** Check inactive Dispense drug within the order.
"RTN","PSGOEE",73,0)
D CHKDRG^PSGOE2
"RTN","PSGOEE",74,0)
Q
"RTN","PSGOEE",75,0)
CKDT ; Check if new start/stop dates should be calculated.
"RTN","PSGOEE",76,0)
S PSGS0Y=$S($D(PSGS0Y):PSGS0Y,1:$G(PSGAT))
"RTN","PSGOEE",77,0)
;PSJ*5*179 Recalc start date if Before last given
"RTN","PSGOEE",78,0)
I
($P($G(PSBSTR),"^")>PSGSD)!('$G(PSGNEWDT)&(PSGSD=$G(PSGOSD))&(PSGFD=$G(PSGOFD)))!($G(PSG
OST)'=PSGST)!(PSGSCH'=$G(PSGOSCH))!($G(PSGPDNX)) D
"RTN","PSGOEE",79,0)
.N PSGOES S PSGOES=1,PSGOFD=PSGFD D ^PSGNE3 I $G(PSGOFD) S PSGNEFD=PSGFD
"RTN","PSGOEE",80,0)
.;S
PSGSD=PSGNESD,PSGSDN=$$ENDD^PSGMI(PSGNESD)_U_$$ENDTC^PSGMI(PSGNESD),PSGFD=PSGNEFD
,PSGFDN=$$ENDD^PSGMI(PSGNEFD)_U_$$ENDTC^PSGMI(PSGNEFD),PSGNEWDT=1 ;373
"RTN","PSGOEE",81,0)
.S
PSGSD=PSGNESD,PSGSDN=$$ENDD^PSGMI(PSGNESD)_U_$$ENDTC2^PSGMI(PSGNESD),PSGFD=PSGNEF
D,PSGFDN=$$ENDD^PSGMI(PSGNEFD)_U_$$ENDTC2^PSGMI(PSGNEFD),PSGNEWDT=1 ;373
"RTN","PSGOEE",82,0)
.I $D(PSGOFD),PSGOFD]"",PSGFD'=PSGOFD S PSGOEEF(25)=1
"RTN","PSGOEE",83,0)
.I $D(PSGOSD),PSGOSD]"",PSGSD'=PSGOSD S PSGOEEF(10)=1
"RTN","PSGOEE",84,0)
;BHW;PSJ*5*179;Add EFD call here, removed from PSGOE91
"RTN","PSGOEE",85,0)
D EFDACT^PSJUTL
"RTN","PSGOEE",86,0)
Q
"RTN","PSGOEE",87,0)
NEW3 ;
"RTN","PSGOEE",88,0)
;S:PSGOEAV PSGOEAV="0^1"
"RTN","PSGOEE",89,0)
NEW ;
"RTN","PSGOEE",90,0)
I $D(^PS(53.45,+$G(PSJSYSP),5)) N PSJFSI S PSJFSI=1 D FILESI^PSJBCMA5(DFN,PSGORD) N SIARRAY S
SIARRAY="" D
"RTN","PSGOEE",91,0)
.I PSGORD["P" M SIARRAY=^PS(53.1,+PSGORD,15) D NEWNVAL^PSGAL5(PSGORD,6000,"SPECIAL
INSTRUCTIONS",,.SIARRAY)
"RTN","PSGOEE",92,0)
.I PSGORD["U" M SIARRAY=^PS(55,DFN,5,+PSGORD,15) D NEWUDAL^PSGAL5(PSGORD,6000,"SPECIAL
INSTRUCTIONS",,.SIARRAY)
"RTN","PSGOEE",93,0)
W !,"...discontinuing original order..."
"RTN","PSGOEE",94,0)
I PSGORD["P" S PSJCOM=+$P($G(^PS(53.1,+PSGORD,.2)),"^",8) I PSJCOM D NEW^PSJCOM1 Q
"RTN","PSGOEE",95,0)
;DC and Unlock order.
"RTN","PSGOEE",96,0)
S PSGEDIT="DE" D ENOR^PSGOECS,UNL^PSSLOCK(PSGP,PSGORD) K PSGEDIT
"RTN","PSGOEE",97,0)
W !!," ...creating new order..." W:'PSGOEAV "(you will now work on this new order)"
"RTN","PSGOEE",98,0)
S
PSGS0Y=PSGAT,PSGNESD=PSGSD,PSGNEFD=PSGFD,PSGOEPR=PSGPR,PSGPDRG=PSGPD,PSGPDRGN=PSG
PDN,PSGOEE="E"
"RTN","PSGOEE",99,0)
S PSGOORD=PSGORD D ^PSGOETO K PSGOEOS
"RTN","PSGOEE",100,0)
I PSGOORD["U" S $P(^PS(55,PSGP,5,+PSGOORD,0),"^",26,27)=PSGORD_"^E"
"RTN","PSGOEE",101,0)
E S $P(^PS(53.1,+PSGOORD,0),"^",26,27)=PSGORD_"^E"
"RTN","PSGOEE",102,0)
I $G(PSJFSI) I $$GETSI^PSJBCMA5(DFN,PSGOORD) D FILESI^PSJBCMA5(DFN,PSGORD)
"RTN","PSGOEE",103,0)
I 'PSGOEAV,($G(PSGORD)["P"),'$G(^PS(53.1,+PSGORD,2.5)),$G(^PS(53.1,+PSGORD,0)) D
"RTN","PSGOEE",104,0)
. N DUR S DUR=$$GETDUR^PSJLIVMD(PSGP,PSGORD,$S(PSGORD["P":"P",1:5),1) I DUR]"" K DA,DR,DIE S
DIE="^PS(53.1,",DA=+PSGORD,DR="116////"_DUR D ^DIE
"RTN","PSGOEE",105,0)
I PSGOEAV D
"RTN","PSGOEE",106,0)
. S ^TMP("PSODAOC",$J,"IP IEN")=PSGORD
"RTN","PSGOEE",107,0)
. D SETOC^PSJNEWOC(PSGORD) ;PSJ*5*281 stores order checks
"RTN","PSGOEE",108,0)
I PSGOEAV,+PSJSYSU=3,'$D(PSGOES) D EN^PSGPEN(PSGORD),UNL^PSSLOCK(PSGP,PSGORD) Q
"RTN","PSGOEE",109,0)
S PSJORD=PSGORD,PSGACT=$$ENACTION^PSGOE1(PSGP,PSGORD)
"RTN","PSGOEE",110,0)
;K ^TMP("PSODAOC",$J),^TMP("PSJDAOC",$J)
"RTN","PSGOEE",111,0)
Q
"RTN","PSGOEE",112,0)
UPD ;
"RTN","PSGOEE",113,0)
K DA W !!,"...updating order..."
"RTN","PSGOEE",114,0)
I PSGORD["P" S PSJCOM=+$P($G(^PS(53.1,+PSGORD,.2)),"^",8) I PSJCOM D UPD^PSJCOM Q
"RTN","PSGOEE",115,0)
I $$DIFFSI^PSJBCMA5(DFN,PSGORD) D
"RTN","PSGOEE",116,0)
.N SIARRAY M:PSGORD["P" SIARRAY=^PS(53.1,+PSGORD,15) M:PSGORD["U"
SIARRAY=^PS(55,DFN,5,+PSGORD,15)
"RTN","PSGOEE",117,0)
.Q:'$D(SIARRAY)
"RTN","PSGOEE",118,0)
.I PSGORD["P" D NEWNVAL^PSGAL5(PSGORD,6000,"SPECIAL INSTRUCTIONS",,.SIARRAY)
"RTN","PSGOEE",119,0)
.I PSGORD["U" D NEWUDAL^PSGAL5(DFN,PSGORD,6000,"SPECIAL INSTRUCTIONS",,.SIARRAY)
"RTN","PSGOEE",120,0)
; Set trigger for FIELD (12) Dispense Drug to print a updated pick list.
"RTN","PSGOEE",121,0)
I PSGORD["U",$D(^PS(53.45,PSJSYSP,2,1,0)),$D(^PS(55,PSGP,5,+PSGORD,1,1,0)) D
"RTN","PSGOEE",122,0)
.N PSJX12,PSJF12 S PSJF12=0
"RTN","PSGOEE",123,0)
.F PSJX12=0:1 S PSJX12=$O(^PS(53.45,PSJSYSP,2,PSJX12)) Q:+PSJX12=0
S:$G(^PS(53.45,PSJSYSP,2,PSJX12,0))'=$G(^PS(55,PSGP,5,+PSGORD,1,PSJX12,0)) PSJF12=1
"RTN","PSGOEE",124,0)
.S:PSJF12 ^PS(55,"AUE",PSGP,+PSGORD)=""
"RTN","PSGOEE",125,0)
N TMP,PSGSIF S TMP=PSGOEENO N PSGOEENO S PSGOEENO=TMP
"RTN","PSGOEE",126,0)
N II F II=1:1:$L($G(DR),";") I $E($P($G(DR),";",II),1,7)="122////" S
PSGSIF=$P(PSGSI,"^",2),PSGSI=$P(PSGSI,"^") Q
"RTN","PSGOEE",127,0)
I $G(PSJCOM),$G(PSJCOMSI) K PSJCOMSI,^TMP("PSGSI",$J) M
^TMP("PSGSI",$J,5)=^PS(53.45,PSJSYSP,5) D
"RTN","PSGOEE",128,0)
.D FILESI^PSJBCMA5(DFN,PSGORD)
"RTN","PSGOEE",129,0)
.N PSJCHILD,PSJOEORD S PSJOEORD=0 F S PSJOEORD=$O(^PS(55,"ACX",PSJCOM,PSJOEORD))
Q:'PSJOEORD D
"RTN","PSGOEE",130,0)
.. S PSJCHILD=0 F S PSJCHILD=$O(^PS(55,"ACX",PSJCOM,PSJOEORD,PSJCHILD)) Q:'PSJCHILD D
"RTN","PSGOEE",131,0)
... Q:PSJCHILD=PSGORD N DR,DA,DIE,ORD S
DR=$S(PSJCHILD["V":"31////"_$G(P("OPI")),1:"8////"_$G(PSGSI)) S
DR=DR_";"_$S(PSJCHILD["V":146,1:122)_"////"_+$G(PSGSIF)
"RTN","PSGOEE",132,0)
... I '$D(^PS(53.45,+$G(PSJSYSP),5)) M ^PS(53.45,+$G(PSJSYSP),5)=^TMP("PSGSI",$J,5)
"RTN","PSGOEE",133,0)
... D FILESI^PSJBCMA5(DFN,PSJCHILD)
"RTN","PSGOEE",134,0)
... ;PSJ*5*179 Comment edits
"RTN","PSGOEE",135,0)
... S DR=$TR($G(DR),"*") I DR'="" S
DA=+PSJCHILD,DIE=$S(PSJCHILD["U":"^PS(55,"_PSGP_",5,",1:"^PS(53.1,") S:DIE["^PS(55," DA(1)=PSGP D
^DIE W "." D EN1^PSJHL2(PSGP,"XX",+PSJCHILD_"U")
"RTN","PSGOEE",136,0)
. K ^TMP("PSGSI",$J)
"RTN","PSGOEE",137,0)
S DR=$TR(DR,"*") I DR'="" S DA=+PSGORD,DIE=$S(PSGORD["U":"^PS(55,"_PSGP_",5,",1:"^PS(53.1,")
S:DIE["^PS(55," DA(1)=PSGP D ^DIE W "."
"RTN","PSGOEE",138,0)
F Q=1,3 K @(PSGOEEWF_Q_")") S
%X="^PS(53.45,"_PSJSYSP_","_$S(Q=1:2,1:1)_",",%Y=PSGOEEWF_Q_"," K @(PSGOEEWF_Q_")") D
%XY^%RCR W "."
"RTN","PSGOEE",139,0)
S $P(@(PSGOEEWF_"1,0)"),"^",2)=$S(PSGORD["U":55.07,1:53.11)_"P"
"RTN","PSGOEE",140,0)
I $D(^PS(53.45,+$G(PSJSYSP),5)) D FILESI^PSJBCMA5(DFN,PSJORD)
"RTN","PSGOEE",141,0)
; Naked reference on the line below refers to full reference using indirection to either ^PS(55 or
^PS(53.1,
"RTN","PSGOEE",142,0)
S ND=$G(@($S(PSGORD["U":"^PS(55,"_PSGP_",5,",1:"^PS(53.1,")_+PSGORD_",0)")) I $P(ND,"^",21) S
ORIFN=$P(ND,"^",21),ND1=$G(^(.2)),ND2=$G(^(2)),ND2P1=$G(^(2.1)) W !,"...updating OE/RR..." D
EN1^PSJHL2(PSGP,"XX",PSGORD) ;*315
"RTN","PSGOEE",143,0)
I $$ENACTION^PSGOE1(PSGP,PSGORD)["V" S VALMBCK="R"
"RTN","PSGOEE",144,0)
I PSJSYSL,PSJSYSL<3 S
$P(@($S(PSGORD["U":"^PS(55,"_PSGP_",5,",1:"^PS(53.1,")_+PSGORD_",7)"),"^",1,2)=PSGDT_"^"_$E("D
",PSGOEENO)_"E",PSGTOL=2,PSGUOW=DUZ,PSGTOO=PSGORD'["U"+1,DA=+PSGORD D ENL^PSGVDS
"RTN","PSGOEE",145,0)
; **This is where the Automated Dispensing Machine hook is called. Do NOT DELETE or change this
location **
"RTN","PSGOEE",146,0)
D EDIT^PSJADM
"RTN","PSGOEE",147,0)
; **END of Interface Hook **
"RTN","PSGOEE",148,0)
Q
"RTN","PSGOEE",149,0)
OUT ;
"RTN","PSGOEE",150,0)
D ABORT K PSGNEWDT S PSGCANFL=1 D
GETUD^PSJLMGUD(PSGP,PSGORD),ENSFE^PSGOEE0(PSGP,PSGORD),INIT^PSJLMUDE(PSGP,PSGORD)
"RTN","PSGOEE",151,0)
Q
"RTN","PSGOEE",152,0)
DONE ;
"RTN","PSGOEE",153,0)
I PSGORD["P",'$D(PSGOEF),PSGSCH]"",$O(^PS(53.1,+PSGORD,1,0)) D ENF^PSGOEE0
"RTN","PSGOEE",154,0)
DONE1 ;
"RTN","PSGOEE",155,0)
I PSGORD["U" S X=+PSGORD L -^PS(55,PSGP,5,X)
"RTN","PSGOEE",156,0)
E L -^PS(53.1,+PSGORD)
"RTN","PSGOEE",157,0)
K ^PS(53.45,+PSJSYSP,1),^(2),^(5),^(6)
"RTN","PSGOEE",158,0)
I '$D(PSGOEF) K PSGSD,PSGSCH,PSGST,PSGFD
"RTN","PSGOEE",159,0)
K
DA,DIE,DIR,DP,DR,DRG,ND,ND0,ND1,ND2,ND2P1,ORIFN,PSGAL,PSGALEF,PSGAT,PSGOEE,PSGOEEF,PSGO
EEG,PSGOEEWF,PSGEFN,PSGTOL,PSGTOO,PSGUOW,XREF,PSGEFN,PSGMR,PSGMRN,PSGOROE1,PSGPD,P
SGPDN,PSGSI,PSGPR,PSGSM,PSGHSM,PSGSTN,PSGSDN,PSGFDN,PSGPRN
"RTN","PSGOEE",160,0)
K PSGDO,PSGOEENO Q
"RTN","PSGOEE",161,0)
K1 ;
"RTN","PSGOEE",162,0)
K
BACK,F1,F2,PSGF2,MSG,PSGEFN,PSGNEWDT,PSGOEEND,PSGOPD,PSGOPDN,PSGOMR,PSGOMRN,PSGOS
CH,PSGOSI,PSGOPR,PSGOSM,PSGOHSM,PSGOSD,PSGOFD,PSGOST,PSGOPRN,PSGOSTN,PSGOSDN,PSGOF
DN,PSGODO,PSGPDRG,PSGPDRGN,PSGOEER
"RTN","PSGOEE",163,0)
Q
"RTN","PSGOEE",164,0)
;
"RTN","PSGOEE",165,0)
ABORT ; Display no change message and pause.
"RTN","PSGOEE",166,0)
D FULL^VALM1
"RTN","PSGOEE",167,0)
S (PSGDI,PSGDFLG)='$$DDOK^PSGOE2(PSGOEEWF_"1,",+$G(@(PSGOEEWF_".2)")))
"RTN","PSGOEE",168,0)
S PSGPFLG='$$OIOK^PSGOE2(+$G(@(PSGOEEWF_".2)")))
"RTN","PSGOEE",169,0)
I '$G(PSJRNFLG) W !!,$C(7),"No changes made to this order." D PAUSE^VALM1 ;if flag set in PSODGAL1,
no repeat message
"RTN","PSGOEE",170,0)
K PSGOEEF S PSGOEEF=0
"RTN","PSGOEE",171,0)
Q
"RTN","PSGOEE",172,0)
;
"RTN","PSGOEE",173,0)
GTSTATUS ; Determine status of new order and set LM title.
"RTN","PSGOEE",174,0)
S PSGSTAT=$S($P($G(PSJSYSP0),U,9):"ACTIVE",1:"NON-VERIFIED")
"RTN","PSGOEE",175,0)
S VALM("TITLE")=PSGSTAT_" UNIT DOSE "_$S(PSGSTAT="PENDING":"("_PSGPRIO_")",1:"")
"RTN","PSGOEE",176,0)
Q
"RTN","PSGOEE",177,0)
;
"RTN","PSGOEE",178,0)
ASKOVR(Y,PSJOVRON,PSJSTARI) ; Check to see if any starred fields are being edited. If so, ask if they
wish to view overrides/interventions if they exist
"RTN","PSGOEE",179,0)
Q:'$D(Y)!$D(PSJSTARI) N II,I3,YY S YY=$S(Y:Y,1:$TR($P(Y,"^",4),"="))
"RTN","PSGOEE",180,0)
Q:'YY S PSJOVRON=$S($G(PSJOVRON):PSJOVRON,1:$G(PSJORD)) Q:'$G(PSJOVRON)
"RTN","PSGOEE",181,0)
N PSJORD S PSJORD=PSJOVRON
"RTN","PSGOEE",182,0)
I '$G(PSJSTARI) F II=1:1:$L(YY,",") Q:$G(PSJSTARI) S I3=$P(YY,",",II) I I3
S:$G(PSGEFN(I3))!($G(PSJSTAR)[("("_I3_")")) PSJSTARI=1
"RTN","PSGOEE",183,0)
I $G(PSJSTARI) I ($G(PSJORD)&$G(PSGP)) I $$ASKDISP^PSGSICH1 D FULL^VALM1 D
OVRDISP^PSGSICH2(PSGP,PSJORD,3)
"RTN","PSGOEE",184,0)
Q
"RTN","PSGOEE",185,0)
;
"RTN","PSGOEE",186,0)
FIELDS ;
"RTN","PSGOEE",187,0)
31 ;;101^PSGOE8;PSGOPD;PSGPD;101;1
"RTN","PSGOEE",188,0)
32 ;;109^PSGOE8;PSGODO;PSGDO;109;PSGODO]""
"RTN","PSGOEE",189,0)
33 ;;10^PSGOE81;PSGOSD;PSGSD;10;0
"RTN","PSGOEE",190,0)
34 ;;3^PSGOE8;PSGOMR;PSGMR;3;1
"RTN","PSGOEE",191,0)
35 ;;25^PSGOE81;PSGOFD;PSGFD;25;0
"RTN","PSGOEE",192,0)
36 ;;7^PSGOE8;PSGOST;PSGST;7;0
"RTN","PSGOEE",193,0)
37 ;;5^PSGOE82;PSGOSM;PSGSM;5;0
"RTN","PSGOEE",194,0)
38 ;;26^PSGOE8;PSGOSCH;PSGSCH;26;1
"RTN","PSGOEE",195,0)
39 ;;39^PSGOE81;PSGOAT;PSGAT;39;0
"RTN","PSGOEE",196,0)
310 ;;1^PSGOE82;PSGOPR;PSGPR;1;1
"RTN","PSGOEE",197,0)
311 ;;8^PSGOE81;PSGOSI;PSGSI;8;0
"RTN","PSGOEE",198,0)
312 ;;2^PSGOE82;;;2;0
"RTN","PSGOEE",199,0)
313 ;;40^PSGOE82;;;40;0
"RTN","PSGOEE",200,0)
51 ;;101^PSGOE9;PSGOPD;PSGPD;101;1
"RTN","PSGOEE",201,0)
52 ;;109^PSGOE9;PSGODO;PSGDO;109;PSGODO]""
"RTN","PSGOEE",202,0)
53 ;;10^PSGOE91;PSGOSD;PSGSD;10;1
"RTN","PSGOEE",203,0)
54 ;;3^PSGOE9;PSGOMR;PSGMR;3;1
"RTN","PSGOEE",204,0)
55 ;;34^PSGOE91;PSGOFD;PSGFD;34;1
"RTN","PSGOEE",205,0)
56 ;;7^PSGOE9;PSGOST;PSGST;7;0
"RTN","PSGOEE",206,0)
57 ;;5^PSGOE92;PSGOSM;PSGSM;5;0
"RTN","PSGOEE",207,0)
58 ;;26^PSGOE9;PSGOSCH;PSGSCH;26;1
"RTN","PSGOEE",208,0)
59 ;;41^PSGOE91;PSGOAT;PSGAT;41;0
"RTN","PSGOEE",209,0)
510 ;;1^PSGOE92;PSGOPR;PSGPR;1;1
"RTN","PSGOEE",210,0)
511 ;;8^PSGOE91;PSGOSI;PSGSI;8;0
"RTN","PSGOEE",211,0)
512 ;;2^PSGOE92;;;2;0
"RTN","PSGOEE",212,0)
513 ;;15^PSGOE92;;;15;0
"RTN","PSGOEEW")
0^6^B29287658^B29287446
"RTN","PSGOEEW",1,0)
PSGOEEW ;BIR/CML3 - SHOW FIELDS FOR EDIT ;Jul 02, 2018@09:21
"RTN","PSGOEEW",2,0)
;;5.0;INPATIENT MEDICATIONS;**7,58,111,315,373**;16 DEC 97;Build 3
"RTN","PSGOEEW",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","PSGOEEW",4,0)
; Reference to ^PS(51.2 is supported by DBIA 2178.
"RTN","PSGOEEW",5,0)
; Reference to ^PSDRUG( is supported by DBIA 2192.
"RTN","PSGOEEW",6,0)
;
"RTN","PSGOEEW",7,0)
EN1 ;
"RTN","PSGOEEW",8,0)
S PSGORD=^TMP("PSJON",$J,PSGOE2)
"RTN","PSGOEEW",9,0)
;
"RTN","PSGOEEW",10,0)
EN2 ;
"RTN","PSGOEEW",11,0)
N %X,%Y,AT,RT,DO,DRGI,FD,FL,FQC,NF,PRI,SD,SIG,ST,STD,STT,X,Y ;*315
"RTN","PSGOEEW",12,0)
;naked references below refer to the full reference in the indirection @(PSGOEEWF_"0")
"RTN","PSGOEEW",13,0)
S
OD=$G(@(PSGOEEWF_"0)")),AT=$G(^(2)),RT=$G(^(2.1)),PSGEB=$P($G(^(4)),"^",7),PSGOSI=$G(^(6)),DO
=$G(^(.2)),PSGOINST=$G(^(.3)),PSGOPD=$P(DO,"^"),PSGODO=$P(DO,"^",2) ;*315
"RTN","PSGOEEW",14,0)
S
PSGOPR=$P(OD,"^",2),PSGOMR=$P(OD,"^",3),PSGOSM=$P(OD,"^",5),PSGOHSM=$P(OD,"^",6),(PSGOST,
ST)=$P(OD,"^",7),(PSGSTAT,STT)=$P(OD,"^",9),PSGOMRN=$S('PSGOMR:"",1:$P($G(^PS(51.2,PSGOMR,0)
),"^")) S:PSGOMRN="" PSGOMRN=PSGOMR
"RTN","PSGOEEW",15,0)
S
PSGLI=$P(OD,U,16),PSGNEDFD=$P($$GTNEDFD^PSGOE7("U",PSGOPD),U),PSGOSCH=$P(AT,"^"),(PSGOS
D,SD)=$P(AT,"^",2),(FD,PSGOFD)=$P(AT,"^",4),(FQC,PSGS0XT)=$P(AT,"^",6),(PSGOAT,PSGS0Y)=$P(AT,"^
",5)
"RTN","PSGOEEW",16,0)
S
PRI=$S('PSGOPR:0,1:$P($G(^VA(200,PSGOPR,"PS")),"^",4)),DRGI=$S(PSGOPD'=+PSGOPD:0,1:+$G(^PSDR
UG(+PSGOPD,"I"))) S:PRI PRI=DT'<PRI S:DRGI DRGI=DT'<DRGI
"RTN","PSGOEEW",17,0)
S PDRG=PSGOPD,PSGOPDN=$S('PSGOPD:"",1:$$OINAME^PSJLMUTL(+PSGOPD)) S:PSGOPDN=""
PSGOPDN=PSGOPD S PSGOPRN=$S('PSGOPR:"",1:$P($G(^VA(200,PSGOPR,0)),"^")) S:PSGOPRN=""
PSGOPRN=PSGOPR ; I PSGOSI]"" S PSGOSI=$$ENSET^PSGSICHK(PSGOSI)
"RTN","PSGOEEW",18,0)
S PSGEBN=$$ENNPN^PSGMI(PSGEB)
"RTN","PSGOEEW",19,0)
S PSGSTAT=$S(STT="":"NOT
FOUND",STT="RE":"REINSTATED",1:$P(STT_"^ACTIVE^DISCONTINUED^EXPIRED^HOLD^INCOMPLETE^N
ON-VERIFIED^PENDING^RENEWED^UNRELEASED","^",$F("ADEHINPRU",STT)))
"RTN","PSGOEEW",20,0)
;
"RTN","PSGOEEW",21,0)
SET ;
"RTN","PSGOEEW",22,0)
;S PSGOSTN=$$ENSTN^PSGMI(ST),(PSGOFDN,PSGOSDN)="" I SD S
PSGOSDN=$$ENDD^PSGMI(SD)_"^"_$$ENDTC^PSGMI(SD) ;373
"RTN","PSGOEEW",23,0)
S PSGOSTN=$$ENSTN^PSGMI(ST),(PSGOFDN,PSGOSDN)="" I SD S
PSGOSDN=$$ENDD^PSGMI(SD)_"^"_$$ENDTC2^PSGMI(SD) ;373
"RTN","PSGOEEW",24,0)
;I FD S PSGOFDN=$$ENDD^PSGMI(FD)_"^"_$$ENDTC^PSGMI(FD) ;373
"RTN","PSGOEEW",25,0)
I FD S PSGOFDN=$$ENDD^PSGMI(FD)_"^"_$$ENDTC2^PSGMI(FD) ;373
"RTN","PSGOEEW",26,0)
F
X="PD","PDN","MR","MRN","ST","STN","SCH","SI","SD","SDN","FD","FDN","SM","HSM","PR","PRN","DO
","AT" S @("PSG"_X)=@("PSGO"_X)
"RTN","PSGOEEW",27,0)
K ^PS(53.45,PSJSYSP,1),^(2) S %X=PSGOEEWF_"3,",%Y="^PS(53.45,"_PSJSYSP_",1," D %XY^%RCR S
%X=PSGOEEWF_"1,",%Y="^PS(53.45,"_PSJSYSP_",2," D %XY^%RCR
"RTN","PSGOEEW",28,0)
S $P(^PS(53.45,PSJSYSP,2,0),"^",2)="53.4502P"
"RTN","PSGOEEW",29,0)
Q
"RTN","PSGOEEW",30,0)
;
"RTN","PSGOEEW",31,0)
ENW ;
"RTN","PSGOEEW",32,0)
N D,ND,Q,QQ
"RTN","PSGOEEW",33,0)
W:$Y @IOF,! W " Patient: ",$P(PSGP(0),"^")," (",PSJPPID,")",?55,"Ht(cm): " W:PSJPHT["_" PSJPHT
W:PSJPHT'["_" $J(PSJPHT,6,2)
"RTN","PSGOEEW",34,0)
W " ",PSJPHTD,!?4,"Ward: ",PSJPWDN,?55,"Wt(kg): " W:PSJPWT["_" PSJPWT W:PSJPWT'["_"
$J(PSJPWT,6,2) W " ",PSJPWTD,!,"Room-Bed: ",PSJPRB
"RTN","PSGOEEW",35,0)
W !,"Order Status: ",PSGSTAT,?37,"Entered By: ",PSGEBN,!,"----------------------------------------------------------
----------------------"
"RTN","PSGOEEW",36,0)
W !?1,$S($D(PSGEFN(1)):$E(" *",PSGEFN(1)+1)_"(1)",1:" "),?16,"Drug: ",PSGPDN
"RTN","PSGOEEW",37,0)
W !?1,$S($D(PSGEFN(2)):$E(" *",PSGEFN(2)+1)_"(2)",1:" "),?6,"Dosage Ordered:
",PSGDO,?46,$S($D(PSGEFN(12)):$E(" *",PSGEFN(12)+1)_"(12)",1:" ")," Start: ",$P(PSGSDN,"^",2)
"RTN","PSGOEEW",38,0)
W !?1,$S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:" "),?11,"Med Route:
",PSGMRN,?46,$S($D(PSGEFN(13)):$E(" *",PSGEFN(13)+1)_"(13)",1:" ")," Stop: ",$P(PSGFDN,"^",2)
"RTN","PSGOEEW",39,0)
W !?1,$S($D(PSGEFN(4)):$E(" *",PSGEFN(4)+1)_"(4)",1:" "),?7,"Schedule Type:
",PSGSTN,?46,$S($D(PSGEFN(14)):$E(" *",PSGEFN(14)+1)_"(14)",1:" ")," Self Med:
",$P("NO^YES","^",PSGSM+1) I PSGSM,PSGHSM W " (HS)"
"RTN","PSGOEEW",40,0)
W !?1,$S($D(PSGEFN(5)):$E(" *",PSGEFN(5)+1)_"(5)",1:" "),?12,"Schedule: ",PSGSCH
"RTN","PSGOEEW",41,0)
W !?1,$S($D(PSGEFN(6)):$E(" *",PSGEFN(6)+1)_"(6)",1:" "),?9,"Admin Times: ",PSGAT
"RTN","PSGOEEW",42,0)
W !?1,$S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:" "),?12,"Provider: ",PSGPRN
"RTN","PSGOEEW",43,0)
W !?1,$S($D(PSGEFN(8)):$E(" *",PSGEFN(8)+1)_"(8)",1:" ")," Special Instructions: " I PSGSI]"" F
Q=1:1:$L(PSGSI," ") S QQ=$P(PSGSI," ",Q) W:$L(QQ)+$X>79 !?28 W QQ," "
"RTN","PSGOEEW",44,0)
W !!?1,$S($D(PSGEFN(9)):$E(" *",PSGEFN(9)+1)_"(9)",1:" ")," Dispense Drug",?48,"U/D",?60,"Inactive
Date",!,"-------------------------------------------------------------------------------"
"RTN","PSGOEEW",45,0)
F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q S ND=$G(^(Q,0)) D
"RTN","PSGOEEW",46,0)
.S D=$P(ND,"^"),PSGID=$P(ND,"^",3) I PSGID S PSGID=$$ENDTC^PSGMI(PSGID)
"RTN","PSGOEEW",47,0)
.S D=$S(D="":"NOT FOUND",'$D(^PSDRUG(D,0)):D,$P(^(0),"^")]"":$P(^(0),"^"),1:D_";PSDRUG(") W
!?6,D,?48,$S($P(ND,"^",2):$P(ND,"^",2),1:1) W:PSGID ?60,PSGID
"RTN","PSGOEEW",48,0)
W !!,$S($D(PSGEFN(10)):$E(" *",PSGEFN(10)+1)_"(10)",1:" ")," Comments:" F Q=0:0 S
Q=$O(^PS(53.45,PSJSYSP,1,Q)) Q:'Q S Y=" "_$G(^(Q,0)) F Y1=2:1 S Y2=$P(Y," ",Y1) Q:Y2=""
W:$L(Y2)+$X>79 !?2 W " ",Y2
"RTN","PSGOEEW",49,0)
W !!,$S($D(PSGEFN(11)):$E(" *",PSGEFN(11)+1)_"(11)",1:" ")," Provider Comments:"
"RTN","PSGOEEW",50,0)
I $G(PSGORD) D
"RTN","PSGOEEW",51,0)
.I $D(^PS(53.1,+PSGORD,12,1)) F Q=0:0 S Q=$O(^PS(53.1,+PSGORD,12,Q)) Q:'Q W !?2,$G(^(Q,0)) Q
"RTN","PSGOEEW",52,0)
.I $D(^PS(53.1,+PSGORD,6)) W !?2,$G(^(6))
"RTN","PSGOEEW",53,0)
K Q,Y,Y1,Y2
"RTN","PSGOEEW",54,0)
Q
"RTN","PSGOEEW",55,0)
;
"RTN","PSGOEEW",56,0)
ENKILL ;
"RTN","PSGOEEW",57,0)
K
PSGAT,PSGEB,PSGFD,PSGHSM,PSGNEFD,PSGNESD,PSGOEEF,PSGOEER,PSGOFD,PSGOHSM,PSGOMR,PSG
OMRN,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGOSD,PSGOSM,PSGOST,PSGPD,PSGPDN,PSGPR,PSGSD,P
SGSM Q
"RTN","PSGOEEW",58,0)
HILIGHT ;
"RTN","PSGOEEW",59,0)
;
"RTN","PSGOEEW",60,0)
5 ;;3,46,34
"RTN","PSGOEEW",61,0)
7 ;;4,7,45
"RTN","PSGOEEW",62,0)
8 ;;8,5,80
"RTN","PSGOEEW",63,0)
10 ;;2,46,34
"RTN","PSGOEEW",64,0)
25 ;;3,46,34
"RTN","PSGOEEW",65,0)
26 ;;6,12,56
"RTN","PSGOEEW",66,0)
39 ;;6,9,71
"RTN","PSGOEEW",67,0)
40 ;;
"RTN","PSGOEEW",68,0)
66 ;;9,5,80
"RTN","PSGOEEW",69,0)
101 ;;1,6,74
"RTN","PSGOEEW",70,0)
109 ;;2,6,40
"RTN","PSGOEF")
0^7^B126624363^B126624192
"RTN","PSGOEF",1,0)
PSGOEF ;BIR/CML3 - FINISH ORDERS ENTERED THROUGH OE/RR ;Jul 02, 2018@09:23
"RTN","PSGOEF",2,0)
;;5.0;INPATIENT
MEDICATIONS;**7,30,29,35,39,47,50,56,80,116,110,111,133,153,134,222,113,181,260,199,281,315,256
,373**;16 DEC 97;Build 3
"RTN","PSGOEF",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","PSGOEF",4,0)
; Reference to ^PS(55 is supported by DBIA 2191
"RTN","PSGOEF",5,0)
; Reference to ^PSDRUG( is supported by DBIA 2192
"RTN","PSGOEF",6,0)
; Reference to DOSE^PSSORPH is supported by DBIA 3234.
"RTN","PSGOEF",7,0)
; Reference to ^TMP("PSODAOC",$J is supported by DBIA 6071.
"RTN","PSGOEF",8,0)
; Reference to FULL^VALM1 is supported by DBIA 10116.
"RTN","PSGOEF",9,0)
; Reference to ^PS(50.7 is supported by DBIA# 2180
"RTN","PSGOEF",10,0)
;
"RTN","PSGOEF",11,0)
START ;
"RTN","PSGOEF",12,0)
I '$D(^PS(53.1,+PSGORD)) W $C(7),!?3,"Cannot find this pending order (#",+PSGORD,")." Q
"RTN","PSGOEF",13,0)
D NOW^%DTC S PSGDT=+$E(%,1,12) K PSGFDX,PSGEFN,PSGOEEF,PSGOES,PSGONF,PSGRDTX S
PSGOES=1,(PSGOEF,PSGOEEF)=0,PSGOEEG=3
"RTN","PSGOEF",14,0)
I $D(PSJTUD) S
PSGDO=$P($G(^PS(53.1,+PSGORD,.3)),U),(PSGPDRG,PSGPD)=PSJCOI,(PSGPDRGN,PSGPDN)=$$OINAME^
PSJLMUTL(PSGPD)
"RTN","PSGOEF",15,0)
I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" S X=PSGSCH D EN^PSGORS0 D
"RTN","PSGOEF",16,0)
. S:($D(X)&($P($G(^PS(53.1,+PSGORD,2)),"^",5)="")&($P($G(^PS(53.1,+PSGORD,0)),"^",24)="N"))
PSGAT=PSGS0Y
"RTN","PSGOEF",17,0)
. NEW PSJDOX,PSJDOSE,PSJPIECE,PSJUNIT,PSJX,X
"RTN","PSGOEF",18,0)
. S X=$G(^PS(53.1,+PSGORD,1,1,0)) Q:'+X
"RTN","PSGOEF",19,0)
. D DOSE^PSSORPH(.PSJDOX,+X,"U")
"RTN","PSGOEF",20,0)
. I $S('$D(PSJDOX):1,1:+PSJDOX(1)=-1) Q
"RTN","PSGOEF",21,0)
. S PSJPIECE=$S($P(PSJDOX(1),U)="":3,1:1)
"RTN","PSGOEF",22,0)
. S X=^PS(53.1,+PSGORD,.2)
"RTN","PSGOEF",23,0)
. S:PSJPIECE=3 PSJDOSE=$P(X,U,2)
"RTN","PSGOEF",24,0)
. S:PSJPIECE=1 PSJDOSE=$P(X,U,5),PSJUNIT=$P(X,U,6)
"RTN","PSGOEF",25,0)
. F X=0:0 S X=$O(PSJDOX(X)) Q:+$G(PSJX)!'X D
"RTN","PSGOEF",26,0)
.. I PSJPIECE=3,($P(PSJDOX(X),U,3)'=PSJDOSE) Q
"RTN","PSGOEF",27,0)
.. I PSJPIECE=1,($P(PSJDOX(X),U,1)_$P(PSJDOX(X),U,2)'=(PSJDOSE_PSJUNIT)) Q
"RTN","PSGOEF",28,0)
.. S:+$P(PSJDOX(X),U,12) $P(^PS(53.45,PSJSYSP,2,1,0),U,2)=+$P(PSJDOX(X),U,12),PSJX=1
"RTN","PSGOEF",29,0)
I PSGEB'=PSGOPR F X=7,11 S
Y=$T(@(3_X)),@("PSGEFN("_X_")="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))="",PSGOEEF=PSGOEEF+1
"RTN","PSGOEF",30,0)
D GTST^PSGOE6(+PSGORD)
"RTN","PSGOEF",31,0)
I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" S PSGSD="" D:PSGS0Y]""
"RTN","PSGOEF",32,0)
.N PSJX S PSJX=$P($G(^PS(53.1,+PSGORD,0)),U,25) I PSJX="" Q
"RTN","PSGOEF",33,0)
.I PSJX["U" S PSGSD=$P($G(^PS(55,DFN,5,+PSJX,2)),U,2) Q
"RTN","PSGOEF",34,0)
.I PSJX["V" S PSGSD=$P($G(^PS(55,DFN,"IV",+PSJX,0)),U,2) Q
"RTN","PSGOEF",35,0)
.I PSJX["P" S PSGSD=$P($G(^PS(53.1,+PSJX,2)),U,2)
"RTN","PSGOEF",36,0)
S:PSGSD="" PSGSD=PSGLI
"RTN","PSGOEF",37,0)
S PSGNEDFD=$$GTNEDFD^PSGOE7("U",+PSGPD)
"RTN","PSGOEF",38,0)
S:$P($G(PSGNEDFD),U,3)="" $P(PSGNEDFD,U,3)=PSGST ; N PSGOEA S PSGOEA="R"
"RTN","PSGOEF",39,0)
S (PSGNESD,PSGSD)=$$ENSD^PSGNE3(PSGSCH,PSGS0Y,PSGLI,PSGSD)
"RTN","PSGOEF",40,0)
;if this is a renewal order, ignore any 'requested start date' received. Use the system calculated start
date.
"RTN","PSGOEF",41,0)
I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" D
"RTN","PSGOEF",42,0)
. D REQDT^PSJLIVMD(PSGORD)
"RTN","PSGOEF",43,0)
E D
"RTN","PSGOEF",44,0)
. S X=$$DSTART^PSJDCU(DFN,$P(^PS(53.1,+PSGORD,0),U,25)) I X]"" S (PSGNESD,PSGSD)=X K PSGRSD
"RTN","PSGOEF",45,0)
D ; Extend the Default Stop Date if needed for the first renewed order.
"RTN","PSGOEF",46,0)
.N PSGOEAO,PSGWALLO
"RTN","PSGOEF",47,0)
.I $P($G(^PS(53.1,+PSGORD,0)),U,24)="R" S
PSGOEAO=PSGOEA,PSGOEA="R",PSGWALLO=$P(^PS(55,DFN,5.1),U)
"RTN","PSGOEF",48,0)
.D ENFD^PSGNE3(PSGLI) S
PSGFD=$S($G(PSGRDTX(+PSGORD,"PSGFD")):PSGRDTX(+PSGORD,"PSGFD"),1:PSGNEFD)
"RTN","PSGOEF",49,0)
.I $P($G(^PS(53.1,+PSGORD,0)),U,24)="R" S PSGOEA=PSGOEAO,$P(^PS(55,DFN,5.1),U)=PSGWALLO
"RTN","PSGOEF",50,0)
N DUR,PSGRNSD S PSGRNSD=+$$LASTREN^PSJLMPRI(DFN,PSGORD) I PSGRNSD S
DUR=$$GETDUR^PSJLIVMD(DFN,PSGORD,"P",1) I DUR]"" D
"RTN","PSGOEF",51,0)
. N DURMIN S DURMIN=$$DURMIN^PSJLIVMD(DUR) I DURMIN S
PSGFD=$$FMADD^XLFDT(PSGRNSD,,,DURMIN)
"RTN","PSGOEF",52,0)
;S
PSGOFD="",PSGSDN=$$ENDD^PSGMI(PSGSD)_U_$$ENDTC^PSGMI(PSGSD),PSGFDN=$$ENDD^PSGMI(PS
GFD)_U_$$ENDTC^PSGMI(PSGFD) ; #373
"RTN","PSGOEF",53,0)
S
PSGOFD="",PSGSDN=$$ENDD^PSGMI(PSGSD)_U_$$ENDTC2^PSGMI(PSGSD),PSGFDN=$$ENDD^PSGMI(P
SGFD)_U_$$ENDTC2^PSGMI(PSGFD) ; #373
"RTN","PSGOEF",54,0)
S PSGLIN=$$ENDD^PSGMI(PSGLI)_U_$$ENDTC^PSGMI(PSGLI)
"RTN","PSGOEF",55,0)
I '$O(^PS(53.45,PSJSYSP,2,0)) N DRG,DRGCNT S DRGCNT=0 D
"RTN","PSGOEF",56,0)
.F X=0:0 S X=$O(^PSDRUG("ASP",+PSGPD,X)) Q:'X!(DRGCNT>1) S:$P($G(^PSDRUG(+X,2)),U,3)["U"
DRGCNT=DRGCNT+1,DRG=+X
"RTN","PSGOEF",57,0)
.I DRGCNT=1 K ^PS(53.45,PSJSYSP,2) S
^PS(53.45,PSJSYSP,2,1,0)=DRG_U_1,^PS(53.45,PSJSYSP,2,0)="^53.4502^1^1",PS(53.45,PSJSYSP,2,"B",+D
RG,1)=""
"RTN","PSGOEF",58,0)
Q
"RTN","PSGOEF",59,0)
FINISH ;
"RTN","PSGOEF",60,0)
; force display of second screen if CPRS order checks exist
"RTN","PSGOEF",61,0)
N NSFF,PSGOEF39,PSGEDTOI S NSFF=1 K PSJNSS,PSGEDTOI,PSGOEER,ZZND
"RTN","PSGOEF",62,0)
N PSJRMABT,PSJOLDNM
"RTN","PSGOEF",63,0)
I $G(PSGORD),$D(PSGRDTX(+PSGORD)) D K PSGRDTX
"RTN","PSGOEF",64,0)
. ;PSJOCDSC stores the default start & stop date ^ cal start & stop date (use in dosing calculation for
duration)
"RTN","PSGOEF",65,0)
. ;for some reasons PSGSD & PSGFD are reset to the cal dates if order has duration defined
"RTN","PSGOEF",66,0)
. S PSJOCDSC("CX","PSGSD",+PSGORD)=$G(PSGSD)_U_$G(PSGRDTX(+PSGORD,"PSGRSD"))
"RTN","PSGOEF",67,0)
. S PSJOCDSC("CX","PSGFD",+PSGORD)=$G(PSGFD)_U_$G(PSGRDTX(+PSGORD,"PSGRFD"))
"RTN","PSGOEF",68,0)
. S:$G(PSGRDTX(+PSGORD,"PSGRSD")) PSGSD=PSGRDTX(+PSGORD,"PSGRSD")
"RTN","PSGOEF",69,0)
. S:$G(PSGRDTX(+PSGORD,"PSGRFD"))
PSGFD=$S($G(PSGRDTX(+PSGORD,"PSGRFD")):PSGRDTX(+PSGORD,"PSGRFD"),1:$G(PSGNEFD))
"RTN","PSGOEF",70,0)
N PSJCOM S PSJCOM=+$P($G(^PS(53.1,+PSGORD,.2)),"^",8)
"RTN","PSGOEF",71,0)
;
"RTN","PSGOEF",72,0)
; PSJ*5*222
"RTN","PSGOEF",73,0)
; PSJCT1 is a counter variable. Every piece of a complex order calls PSGOEF.
"RTN","PSGOEF",74,0)
; The only time this code is to look for overlapping admin times is when the
"RTN","PSGOEF",75,0)
; first part of a complex order is being finished. This variable will keep track
"RTN","PSGOEF",76,0)
; of how many "parts" of the complex order have been checked.
"RTN","PSGOEF",77,0)
;
"RTN","PSGOEF",78,0)
; Also, since the user can select multiple complex orders to finish, like selecting
"RTN","PSGOEF",79,0)
; orders 1-2 or 1-3 from the profile, PSJCT1A will keep track of whether the parent
"RTN","PSGOEF",80,0)
; order number is the same as the first parent order number selected for finishing.
"RTN","PSGOEF",81,0)
; Since the PSJCT1 counter variable will still be set if multiple complex orders
"RTN","PSGOEF",82,0)
; are selected, PSJCT1 will be re-set to 1 if the parent complex order number (PSJCT1A) is
"RTN","PSGOEF",83,0)
; not equal to the original parent order number (PSJCOM).
"RTN","PSGOEF",84,0)
;
"RTN","PSGOEF",85,0)
S PSJCT1=$G(PSJCT1)+1
"RTN","PSGOEF",86,0)
I PSJCT1=1 S PSJCT1A=PSJCOM
"RTN","PSGOEF",87,0)
I $G(PSJCT1A)'=PSJCOM S PSJCT1=1,PSJCT1A=PSJCOM
"RTN","PSGOEF",88,0)
; End of flag setting for PSJ*5*222
"RTN","PSGOEF",89,0)
D FULL^VALM1
"RTN","PSGOEF",90,0)
I '$D(IOINORM)!('$D(IOINHI)) S X="IORVOFF;IORVON;IOINHI;IOINORM" D ENDR^%ZISS
"RTN","PSGOEF",91,0)
I $G(PSJCOM)'="",$G(PSJCT1)=1 D
"RTN","PSGOEF",92,0)
. D OVERLAP^PSGOEF2 I $G(PSJOVRLP)=1 D
"RTN","PSGOEF",93,0)
. . N X,X1,DIR
"RTN","PSGOEF",94,0)
. . W !!,"**WARNING**"
"RTN","PSGOEF",95,0)
. . W !,"The highlighted admin times for these portions of this complex order overlap.",!!
"RTN","PSGOEF",96,0)
. . S (X,X1)="" F S X=$O(^TMP("PSJATOVR",$J,X)) Q:X="" D
"RTN","PSGOEF",97,0)
. . . S X1=$G(^TMP("PSJATOVR",$J,X))
"RTN","PSGOEF",98,0)
. . . W $S($P(X1,"^",4)=1:IORVON,1:""),"Part "_X,IORVOFF," has a schedule of "_$P(X1,"^",2)_" and
admin time(s) of "
"RTN","PSGOEF",99,0)
. . . W $S($P(X1,"^",4)=1:IORVON,1:""),$P(X1,"^",3),IORVOFF
"RTN","PSGOEF",100,0)
. . . W !
"RTN","PSGOEF",101,0)
. . . W $S($G(PSJOVR("CONJ",X))="A":"AND",$G(PSJOVR("CONJ",X))="T":"THEN",1:""),!
"RTN","PSGOEF",102,0)
. . W !,"Please ensure the schedules and administration times are appropriate.",!
"RTN","PSGOEF",103,0)
. . S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR W !
"RTN","PSGOEF",104,0)
K ^TMP("PSJATOVR",$J)
"RTN","PSGOEF",105,0)
I $G(PSJPROT)=3,'$D(PSJTUD),'$$ENIVUD^PSGOEF1(PSGORD) Q
"RTN","PSGOEF",106,0)
;*** PSJ*5*256
"RTN","PSGOEF",107,0)
S PSJOLDNM("ORD_SCHD")=PSGOSCH
"RTN","PSGOEF",108,0)
I $$CHKSCHD^PSJMISC2(.PSJOLDNM,$S($P($G(^PS(53.1,+PSGORD,0)),U,24)="R":"R",1:"")) S
PSGORQF=1,VALMBCK="R" D DONE Q
"RTN","PSGOEF",109,0)
S:$G(PSJOLDNM("NEW_SCHD"))]"" PSGSCH=PSJOLDNM("NEW_SCHD")
"RTN","PSGOEF",110,0)
I $G(PSGOSCH)]"" D S:$G(PSGS0XT)'="" $P(^PS(53.1,+PSGORD,2),"^",6)=PSGS0XT
"RTN","PSGOEF",111,0)
.N PSGOES,PSGS0Y,PSGSCH S
X=$S($G(PSJOLDNM("NEW_SCHD"))]"":PSJOLDNM("NEW_SCHD"),1:PSGOSCH) K:$G(PSJTUD) NSFF D
ENOS^PSGS0
"RTN","PSGOEF",112,0)
.I '($G(PSGORD)["P"&($P($G(^PS(53.1,+PSGORD,0)),"^",24)="R")) I $G(X)]""&$G(PSGS0Y)
S:$G(PSGAT)="" PSGAT=PSGS0Y
"RTN","PSGOEF",113,0)
.I $G(PSJNSS) S PSGOSCH="" K PSJNSS
"RTN","PSGOEF",114,0)
.I $G(PSGORD)["P",$G(PSGAT),$G(PSGS0Y),($G(PSGOSCH)]"") I PSGAT'=PSGS0Y D
"RTN","PSGOEF",115,0)
..S PSGNSTAT=1 W $C(7),!!,"PLEASE NOTE: This order's admin times (",PSGAT,")"
"RTN","PSGOEF",116,0)
..W !?13," do not match the ward times (",PSGS0Y,")"
"RTN","PSGOEF",117,0)
..W !?13," for this administration schedule
(",$S($G(PSJOLDNM("NEW_SCHD"))]"":PSJOLDNM("NEW_SCHD"),1:PSGOSCH),")",!
"RTN","PSGOEF",118,0)
..S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR K DIR W !
"RTN","PSGOEF",119,0)
I $G(PSGS0XT)="" S $P(^PS(53.1,+PSGORD,2),"^",6)=$S($P($G(ZZND),"^",3)'="":$P(ZZND,"^",3),1:"")
"RTN","PSGOEF",120,0)
S CHK=0 S:$P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" PSGSI=$$ENPC^PSJUTL("U",+PSJSYSP,180,PSGSI)
"RTN","PSGOEF",121,0)
I '$G(PSJTUD),$G(PSJNSS),($G(PSGOSCH)]"") D NSSCONT^PSGS0(PSGOSCH,PSGS0XT) K PSJNSS S
PSGOSCH=""
"RTN","PSGOEF",122,0)
S PSGOEFF=PSGOSCH=""+('$O(^PS(53.45,PSJSYSP,2,0))*10)
"RTN","PSGOEF",123,0)
I PSGOEFF S X=$S(PSGOEFF#2:" a SCHEDULE",1:"")_$S(PSGOEFF=11:" and",1:"")_$S(PSGOEFF>9:" at
least one DISPENSE DRUG",1:"")
"RTN","PSGOEF",124,0)
I 'PSGOEFF I (($G(PSGS0XT)="D")&($G(PSGAT)="")) S X=" Admin Times",PSGOEFF=1,PSGOEF39=1
"RTN","PSGOEF",125,0)
; *315 DRP If removal flag in 50.7 is a 2 or a 3 then order must be reviewed and removal times entered
if required.
"RTN","PSGOEF",126,0)
S PSGRF=$P($G(^PS(50.7,$G(PSGPDRG),4),0),U,1)
"RTN","PSGOEF",127,0)
I +$G(PSGRF),$G(PSGDUR)="",'$G(PSGRMV),$D(^PS(51.1,"AC","PSJ",$G(PSGOSCH))) S PSJRMABT=0 D I
$G(PSJRMABT) D ABORTACC Q ; Abort Finish process if no Stop Date entered ($G(PSJRMABT))
"RTN","PSGOEF",128,0)
. N PSGTMPST S
PSGTMPST=$S($G(PSGST)="R":$P($G(^PS(51.1,$O(^PS(51.1,"AC","PSJ",PSGOSCH,"")),0)),"^",5),1:$G(PSG
ST)) ;Handle "Fill on Request"
"RTN","PSGOEF",129,0)
. I ($G(PSGTMPST)'="O"),($G(PSGTMPST)'="P"),($G(PSGTMPST)'="OC"),+$G(PSGRF)>1 S
X="",PSGOEFF=1,PSGOEF39=1
"RTN","PSGOEF",130,0)
. I $G(PSGTMPST)="O" S (PSGFDN,PSGFD)="" D
"RTN","PSGOEF",131,0)
.. S
F1=53.1,MSG=0,Y=$T(35),@("PSGFN(35)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1
W ! D @$P($T(35),";",3) S CHK=0 I 'PSGOEE S PSJRMABT=1
"RTN","PSGOEF",132,0)
.. W:PSJRMABT $C(7),!!,"INVALID STOP DATE" S DIR(0)="EA",DIR("A")="Press Return to continue..." D
^DIR K DIR W !
"RTN","PSGOEF",133,0)
..Q
"RTN","PSGOEF",134,0)
.Q
"RTN","PSGOEF",135,0)
;
"RTN","PSGOEF",136,0)
I PSGOEFF,X]"" S X=X_" before it can be finished."
"RTN","PSGOEF",137,0)
I PSGOEFF,X]"" S CHK=1 W $C(7),!!,"PLEASE NOTE: This order must have" F Q=1:1:$L(X," ") S Y=$P(X,"
",Q) W:$L(Y)+$X>78 ! W Y," "
"RTN","PSGOEF",138,0)
I $G(PSGOEF39) S PSGOEE=0,PSGOEFF=0 D I 'PSGOEE D REFRESH^VALM G DONE
"RTN","PSGOEF",139,0)
.S
F1=53.1,MSG=0,Y=$T(39),@("PSGFN(39)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEEF,PSGOEE)=1
W ! D @$P($T(39),";",3) S CHK=0
"RTN","PSGOEF",140,0)
.I $G(PSGRMVT),'PSGOEE D INIT^PSJLMUDE($G(PSGP),$G(PSGORD)) ;*315 IF REMOVE TIME SET THEN
REDISPLAY DETAIL
"RTN","PSGOEF",141,0)
.Q
"RTN","PSGOEF",142,0)
I PSGOEFF=1 S
F1=53.1,MSG=0,Y=$T(38),@("PSGFN(38)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1
W ! D @$P($T(38),";",3) S CHK=0 G:'PSGOEE DONE
"RTN","PSGOEF",143,0)
I PSGOEFF=11 S
F1=53.1,MSG=0,Y=$T(32),@("PSGFN(32)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1
W ! D @$P($T(32),";",3) D G:'PSGOEE DONE
"RTN","PSGOEF",144,0)
.S
F1=53.1,MSG=0,Y=$T(38),@("PSGFN(38)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1
W ! D @$P($T(38),";",3) S CHK=0
"RTN","PSGOEF",145,0)
I PSGOEFF>9 S CHK=7 D ENDRG^PSGOEF1(+PSGPD,0) I CHK D ABORTACC Q
"RTN","PSGOEF",146,0)
I 'PSGOEFF D OC531^PSGOESF ; check every dispense drug from CPRS
"RTN","PSGOEF",147,0)
S VALMBG=1
"RTN","PSGOEF",148,0)
I 'PSGOEFF&($D(PSGORQF)) D RE^VALM4 Q
"RTN","PSGOEF",149,0)
I $G(MSG) K DIR S DIR(0)="E" W !! D ^DIR
"RTN","PSGOEF",150,0)
I PSGOEFF D:PSGST="" GTST^PSGOE6(+PSGORD)
"RTN","PSGOEF",151,0)
S PSJLMFIN=1
"RTN","PSGOEF",152,0)
K PSJACEPT I $O(^PS(53.1,+PSGORD,12,0)) S PSJLMP2=1
"RTN","PSGOEF",153,0)
S PSGOEENO=0,PSGSTAT=$S($P(PSJSYSP0,U,9):"ACTIVE",1:"NON-VERIFIED")
"RTN","PSGOEF",154,0)
NEW PSJDOSE,PSJDOX,PSJDSFLG
"RTN","PSGOEF",155,0)
D DOSECHK^PSJDOSE
"RTN","PSGOEF",156,0)
S:+$G(PSJDSFLG) VALMSG="Dosage Ordered & Dispense Drug are not compatible"
"RTN","PSGOEF",157,0)
I PSGODO=PSGDO S PSGOEEF(109)=""
"RTN","PSGOEF",158,0)
I PSGODO'=PSGDO S PSGOEENO=1,VALMSG="This change will cause a new order to be created "
"RTN","PSGOEF",159,0)
D EN^VALM("PSJU LM ACCEPT")
"RTN","PSGOEF",160,0)
I $G(PSJNSS) D S PSGOEEF(26)="" K PSJACEPT,PSJNSS
"RTN","PSGOEF",161,0)
.K DIR S DIR(0)="FOA",DIR("A")="Invalid Schedule" D ^DIR K DIR
"RTN","PSGOEF",162,0)
I $G(PSGS0XT)="D",'$G(PSGS0Y),'$G(PSGAT),((",P,R,")'[(","_$G(PSGST)_",")) D S PSGOEEF(39)="" K
PSJACEPT
"RTN","PSGOEF",163,0)
.K DIR S DIR(0)="FOA",DIR("A")=" WARNING - Admin times are required for DAY OF WEEK schedules "
D ^DIR K DIR
"RTN","PSGOEF",164,0)
;***PSJ*5*113
"RTN","PSGOEF",165,0)
I $G(PSGAT)="",(PSGST="C"!(PSGST="R")) D
"RTN","PSGOEF",166,0)
.I $G(PSGS0XT) Q:$$ODD^PSGS0(PSGS0XT)
"RTN","PSGOEF",167,0)
.Q:$$PRNOK^PSGS0($G(PSGSCH))
"RTN","PSGOEF",168,0)
.Q:($P($G(ZZND),"^",5)'="C")
"RTN","PSGOEF",169,0)
.K PSJACEPT
"RTN","PSGOEF",170,0)
.K DIR S DIR(0)="FOA",DIR("A")=" WARNING - Admin times are required for CONTINUOUS orders " D
^DIR K DIR
"RTN","PSGOEF",171,0)
;***
"RTN","PSGOEF",172,0)
I '$G(PSJACEPT) D ABORTACC Q
"RTN","PSGOEF",173,0)
I $G(PSJRNF),$G(^PS(53.1,+PSGORD,4)) D
"RTN","PSGOEF",174,0)
. W $C(7),!!,"ACCEPTING THIS ORDER WILL CHANGE THE STATUS TO ACTIVE."
"RTN","PSGOEF",175,0)
. S DIR(0)="Y",DIR("A")="Do you wish to make this order Active",DIR("?",1)="Enter ""N"" if you wish to
exit without Activating this order,"
"RTN","PSGOEF",176,0)
. S DIR("?")="or ""Y"" to continue with the Activation process." D ^DIR S:'Y Y=-1 K DIR
"RTN","PSGOEF",177,0)
I $G(PSJRNF),$G(Y)=-1 S PSJACEPT=0 D ABORTACC Q
"RTN","PSGOEF",178,0)
I $G(PSJRNF),$G(Y)=1 S PSGOEAV=1
"RTN","PSGOEF",179,0)
I $G(PSGEDTOI) D OC^PSJOE1
"RTN","PSGOEF",180,0)
I
$S($G(PSGORQF):0,$G(PSGEDTOI):0,$G(PSGOEER)["109^PSGOE8":1,$G(PSGOEER)["3^PSGOE8":1,$G(PS
GOEER)["26^PSGOE8":1,$G(PSGOEER)["10^PSGOE81":1,$G(PSGOEER)["25^PSGOE81":1,1:0) D
"RTN","PSGOEF",181,0)
. NEW PSJDD S PSJDD=+$$DD53P45^PSJMISC()
"RTN","PSGOEF",182,0)
. D:$G(PSJDD) IN^PSJOCDS($G(PSGORD),"UD",PSJDD)
"RTN","PSGOEF",183,0)
I $G(PSGORQF) S PSGOEENO=0,PSJACEPT=0
"RTN","PSGOEF",184,0)
I PSGOEENO S PSJNOO=$$ENNOO^PSJUTL5("E"),PSJACEPT=$S(PSJNOO<0:0,1:1)
"RTN","PSGOEF",185,0)
ACCEPT ;
"RTN","PSGOEF",186,0)
N PSGUDFIN S PSGUDFIN=1
"RTN","PSGOEF",187,0)
S VALMBCK=$S($G(PSJACEPT):"Q",1:"R")
"RTN","PSGOEF",188,0)
I '$G(PSJACEPT) D ABORTACC Q
"RTN","PSGOEF",189,0)
;*** PSJ*5*256
"RTN","PSGOEF",190,0)
I $G(PSJOLDNM("NEW_SCHD"))]"" S
PSGSCH=$G(PSJOLDNM("NEW_SCHD")),PSGOEENO=1,PSGOEEF(26)=1,PSJNOO="S"
"RTN","PSGOEF",191,0)
K PSGOES,PSGRSD,PSGRSDN D:PSGOEENO NEW3^PSGOEE D:'PSGOEENO UPD^PSGOEF1 I
$D(PSGOEF)!PSGOEENO S PSGCANFL=-1
"RTN","PSGOEF",192,0)
;saves drug allergy signs/symptoms PSJ*5*260
"RTN","PSGOEF",193,0)
I $D(^TMP("PSODAOC",$J,"ALLERGY")) D
"RTN","PSGOEF",194,0)
.N DA,OCCDT,ORN,ORL,Z,RET,PSJDAOC
"RTN","PSGOEF",195,0)
.S PSJDAOC="IP "_$S($G(PSGORD)["P":"Pending/Non-Verified",$G(PSGORD)["U":"Unit
Dose",$G(PSGORD)["V":"IV",1:"")_" Allergy",OCCDT=$$NOW^XLFDT
"RTN","PSGOEF",196,0)
.I PSGORD["P" S ORN=$P(^PS(53.1,+PSGORD,0),U,21)
"RTN","PSGOEF",197,0)
.I PSGORD["U" S ORN=$P(^PS(55,DFN,5,+PSGORD,0),U,21)
"RTN","PSGOEF",198,0)
.I PSGORD["V" S ORN=$P(^PS(55,DFN,"IV",+PSGORD,0),U,21)
"RTN","PSGOEF",199,0)
.Q:'$G(ORN)
"RTN","PSGOEF",200,0)
. S PSJAGYSV=1 ;use in ^PSJOE to store allergy (also clean up this var)
"RTN","PSGOEF",201,0)
.;D SETOC^PSJNEWOC(PSGORD) ;set order checks in 100.05
"RTN","PSGOEF",202,0)
.;K ^TMP("PSODAOC",$J),^TMP("PSJDAOC",$J)
"RTN","PSGOEF",203,0)
D DONE1^PSGOEE
"RTN","PSGOEF",204,0)
D DONE
"RTN","PSGOEF",205,0)
Q
"RTN","PSGOEF",206,0)
BYPASS ;
"RTN","PSGOEF",207,0)
S PSGCANFL=1
"RTN","PSGOEF",208,0)
;
"RTN","PSGOEF",209,0)
DONE ;
"RTN","PSGOEF",210,0)
K CHK,DA,DIE,DR,DRG,MSG,Q1,Q2,PSGNSTAT,PSGEDTOI,PSGOEER,ZZND
"RTN","PSGOEF",211,0)
K PSJOVR
"RTN","PSGOEF",212,0)
Q
"RTN","PSGOEF",213,0)
ABORTACC ; Abort Accept process.
"RTN","PSGOEF",214,0)
;*315
"RTN","PSGOEF",215,0)
K PSGDUR,PSGRMVT,PSGRMV,PSGRF
"RTN","PSGOEF",216,0)
K PSJCT1,PSJOVR,PSJOVRLP,PSJCT1A K ^TMP("PSODAOC",$J)
"RTN","PSGOEF",217,0)
D ABORT^PSGOEE K PSGOEEF D
GETUD^PSJLMGUD(PSGP,PSGORD),^PSGOEF,ENSFE^PSGOEE0(PSGP,PSGORD),INIT^PSJLMUDE(PSGP,PS
GORD) S VALMBCK="R",PSGSD=PSGNESD,PSGFD=PSGNEFD Q
"RTN","PSGOEF",218,0)
;
"RTN","PSGOEF",219,0)
;
"RTN","PSGOEF",220,0)
31 ;;101^PSGOE8;PSGOPD;PSGPD;101;1
"RTN","PSGOEF",221,0)
32 ;;109^PSGOE8;PSGODO;PSGDO;109;PSGODO]""
"RTN","PSGOEF",222,0)
33 ;;10^PSGOE81;PSGOSD;PSGSD;10;0
"RTN","PSGOEF",223,0)
34 ;;3^PSGOE8;PSGOMR;PSGMR;3;1
"RTN","PSGOEF",224,0)
35 ;;25^PSGOE81;PSGOFD;PSGFD;25;0
"RTN","PSGOEF",225,0)
36 ;;7^PSGOE8;PSGOST;PSGST;7;0
"RTN","PSGOEF",226,0)
37 ;;5^PSGOE82;PSGOSM;PSGSM;5;0
"RTN","PSGOEF",227,0)
38 ;;26^PSGOE8;PSGOSCH;PSGSCH;26;1
"RTN","PSGOEF",228,0)
39 ;;39^PSGOE81;PSGOAT;PSGAT;39;0
"RTN","PSGOEF",229,0)
310 ;;1^PSGOE82;PSGOPR;PSGPR;1;1
"RTN","PSGOEF",230,0)
311 ;;8^PSGOE81;PSGOSI;PSGSI;8;0
"RTN","PSGOEF",231,0)
312 ;;2^PSGOE82;;;2;0
"RTN","PSGOEF",232,0)
313 ;;40^PSGOE82;;;40;0
"RTN","PSGOEF",233,0)
;
"RTN","PSGOEF",234,0)
AH ;
"RTN","PSGOEF",235,0)
W !!?2,"Answer 'YES' to accept this order as a NON-VERIFIED UNIT DOSE order. Answer",!,"'NO' to edit
this order now. Enter '^' to BYPASS this order, leaving it as",!,"a PENDING INPATIENT order."
"RTN","PSGOEF",236,0)
Q
"RTN","PSGVW")
0^8^B33609495^B33609179
"RTN","PSGVW",1,0)
PSGVW ;BIR/CML3 - EXPANDED VIEW OF AN ORDER ;Jul 02, 2018@09:27
"RTN","PSGVW",2,0)
;;5.0;INPATIENT MEDICATIONS;**50,58,85,80,104,110,267,315,373**;16 DEC 97;Build 3
"RTN","PSGVW",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","PSGVW",4,0)
; Reference to ^PS(50.7 is supported by DBIA# 2180.
"RTN","PSGVW",5,0)
; Reference to ^PS(51.2 is supported by DBIA# 2178.
"RTN","PSGVW",6,0)
; Reference to ^PS(55 is supported by DBIA# 2191.
"RTN","PSGVW",7,0)
; Reference to ES^ORX8 is supported by DBIA# 3632.
"RTN","PSGVW",8,0)
;
"RTN","PSGVW",9,0)
EN1 ;
"RTN","PSGVW",10,0)
S PSGORD=^TMP("PSJON",$J,PSGOE2)
"RTN","PSGVW",11,0)
;
"RTN","PSGVW",12,0)
EN2 ;
"RTN","PSGVW",13,0)
I PSGORD=+PSGORD N PSGO,PSGO1 S PSGO=PSGORD,PSGO1=0 F S
PSGO1=$O(^PS(53.1,"ACX",PSGO,PSGO1)) Q:'PSGO1 Q:$G(PSGOEA)["^" S PSGORD=PSGO1_"P" D S
PSGORD=""
"RTN","PSGVW",14,0)
. D EN21 K CONT D Q:$G(PSGOEA)["^"
"RTN","PSGVW",15,0)
.. W !!,"Press RETURN to continue or '^' to exit: " R CONT:DTIME W @IOF S:CONT["^"
PSGOEA="^",PSGPR=1,PSJPR=1
"RTN","PSGVW",16,0)
I PSGORD="" S PSGOEA="^" Q
"RTN","PSGVW",17,0)
EN21 ;
"RTN","PSGVW",18,0)
K ^PS(53.45,PSJSYSP,2),^TMP("PSJBCMA5",$J)
"RTN","PSGVW",19,0)
N ESIG,PSJ21
"RTN","PSGVW",20,0)
S NF=$S(PSGORD["P":1,PSGORD["N":1,1:0)
"RTN","PSGVW",21,0)
S (FL,Y)="",$P(FL,"-",71)="",F="^PS("_$S(NF:"53.1,",1:"55,"_PSGP_",5,")_+PSGORD_","
"RTN","PSGVW",22,0)
S PN=$G(PSGP(0)) S:PN="" PN=$P($G(^DPT(PSGP,0)),"^")
"RTN","PSGVW",23,0)
; the naked reference on the line below refers to the full reference created by indirect reference to
F_ON, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
"RTN","PSGVW",24,0)
S
OD=$G(@(F_"0)")),STAT=$P(OD,U,9),PSJ21=$P(OD,U,21),PDRG=$G(^(.2)),INS=$G(^(.3)),AT=$G(^(2)),RT=
$G(^(2.1)),ND4=$G(^(4)),EB=$P(ND4,"^",7) S:'NF XU=$G(^(5)) S
X=$P($G(^(6)),"^"),SIG=$G(^(6.5)),DO=$G(^(1,1,0)) ;*315
"RTN","PSGVW",25,0)
S
PR=$P(OD,"^",2),MR=$P(OD,"^",3),SM=$P(OD,"^",5),HSM=$P(OD,"^",6),SCT=$S(PSGORD'["P":$P(OD,"^"
,7),1:""),ST=$P(OD,"^",9),(PSGLI,LID)=$P(OD,"^",16),OD=$P(OD,"^",14),DO=$P(PDRG,"^",2),ESIG=$P(PD
RG,"^",3),PDRG=+PDRG
"RTN","PSGVW",26,0)
L S
SCH=$P(AT,"^"),STD=$S(STAT'["P":$P(AT,"^",2),1:""),FD=$S(STAT'["P":$P(AT,"^",4),1:""),FQC=$P(AT,"^",
6),AT=$P(AT,"^",5),RT=$P(RT,U,2) I FQC="D",AT="" S AT=$E($P(STD,".",2)_"0000",1,4) ;*315
"RTN","PSGVW",27,0)
S
PRI=$S('PR:0,1:$P($G(^VA(200,PR,"PS")),"^",4)),DRGI=$S('PDRG:0,1:$P($G(^PS(50.7,PDRG,0)),"^",4)),PR
=$$ENNPN^PSGMI(PR) S:PRI PRI=PRI'>DT S:DRGI DRGI=DRGI'>DT
"RTN","PSGVW",28,0)
I PSJ21]"",$L($T(ES^ORX8)) N ESIG1 S ESIG1=$$ES^ORX8(+PSJ21_";1") S:ESIG1=1 ESIG="ES"
"RTN","PSGVW",29,0)
S PR=PR_$S(ESIG]"":" ["_$$LOW^XLFSTR(ESIG)_"]",1:"")
"RTN","PSGVW",30,0)
S DRG=$$OIDF^PSJLMUT1(+PDRG) S SI=$S(X]"":$$ENSET^PSGSICHK(X),1:"")
"RTN","PSGVW",31,0)
;F Q="FD","LID","OD","STD" S @Q=$$ENDTC^PSGMI(@Q) ;#373
"RTN","PSGVW",32,0)
F Q="LID","OD" S @Q=$$ENDTC^PSGMI(@Q) ;#373
"RTN","PSGVW",33,0)
F Q="FD","STD" S @Q=$$ENDTC2^PSGMI(@Q) ;#373
"RTN","PSGVW",34,0)
Q:$D(PSJLM)
"RTN","PSGVW",35,0)
;
"RTN","PSGVW",36,0)
WRT ;
"RTN","PSGVW",37,0)
Q:($G(@(F_"0)"))="")
"RTN","PSGVW",38,0)
W !! W:'$D(PSGVWA) ?5,FL,! W "Patient: ",PN
"RTN","PSGVW",39,0)
W ?47,"Status: " I ST["D" W "DISCONTINUED",$S(ST["E":" (EDIT)",ST["R":" (RENEWAL)",1:"")
"RTN","PSGVW",40,0)
E W $S(ST="E":"EXPIRED",$P($G(@(F_"0)")),U,27)="R":"RENEWED",ST="":"NOT
FOUND",ST="RE":"REINSTATED",1:$P(ST_"^ACTIVE^HOLD^INCOMPLETE^NON-
VERIFIED^PENDING^UNRELEASED","^",$F("AHINPU",ST)))
"RTN","PSGVW",41,0)
W !,"Orderable Item: ",DRG
"RTN","PSGVW",42,0)
W !?2,"Instructions: ",INS
"RTN","PSGVW",43,0)
W !,"Dosage Ordered: ",DO
"RTN","PSGVW",44,0)
S PSJDUR="" I $G(PSGRDTX) S PSJDUR=$$FMTDUR^PSJLIVMD($P($G(PSGRDTX),U,2))
"RTN","PSGVW",45,0)
I $G(PSGORD),($G(PSJDUR)="") S P=$S(PSGORD["U":5,1:-1) S
PSJDUR=$$GETDUR^PSJLIVMD(PSGP,+PSGORD,P)
"RTN","PSGVW",46,0)
W !?6,"Duration: ",PSJDUR
"RTN","PSGVW",47,0)
W ?48,"Start: ",STD
"RTN","PSGVW",48,0)
W !?5,"Med Route: ",$S(MR:$S($D(^PS(51.2,+MR,0)):$P(^(0),"^")_$S($P(^(0),"^",3)]"":"
("_$P(^(0),"^",3)_")",1:""),1:MR),1:"NOT FOUND")
"RTN","PSGVW",49,0)
;N RNDT,PSGLRN S PSGLRN=$$LASTREN^PSJLMPRI(PSGP,PSGORD) I PSGLRN S
RNDT=$$ENDTC^PSGMI(+PSGLRN) W ?46,"Renewed: ",RNDT ;#373
"RTN","PSGVW",50,0)
N RNDT,PSGLRN S PSGLRN=$$LASTREN^PSJLMPRI(PSGP,PSGORD) I PSGLRN S
RNDT=$$ENDTC2^PSGMI(+PSGLRN) W ?46,"Renewed: ",RNDT ;#373
"RTN","PSGVW",51,0)
W !,$$BCMALG^PSJUTL2(PSGP,PSGORD)
"RTN","PSGVW",52,0)
W ?49,"Stop: ",FD
"RTN","PSGVW",53,0)
I $G(PSGORD),($G(PSJDUR)="") S P=$S(PSGORD["U":5,1:-1) S
PSJDUR=$$GETDUR^PSJLIVMD(PSGP,+PSGORD,P)
"RTN","PSGVW",54,0)
W !?1,"Schedule Type: ",$$ENSTN^PSGMI(SCT)
"RTN","PSGVW",55,0)
W !?6,"Schedule: ",$S(SCH="":"NOT FOUND",$L(SCH)>27:$E(SCH,1,24)_"...",1:SCH)
"RTN","PSGVW",56,0)
W !?3,$S(AT&("P"'[SCT):"Admin Times: "_AT,1:"(No Admin Times)") ;*315
"RTN","PSGVW",57,0)
W !?1,$S(RT&("P"'[SCT):"Removal Times: "_RT,1:""),!?6,"Provider: ",PR
"RTN","PSGVW",58,0)
N SIL S SIL=$$GETSIOPI^PSJBCMA5(PSGP,PSGORD,1) I SIL!(SI]"") D
"RTN","PSGVW",59,0)
.I SI]"",'SIL W !,"Special Instructions: (see below) " D Q
"RTN","PSGVW",60,0)
..F Q=1:1:$L(SI," ") S QQ=$P(SI," ",Q) W !?2,QQ," "
"RTN","PSGVW",61,0)
.Q:'$G(PSJSYSP) N LNTXT S LNTXT=0 F S LNTXT=$O(^TMP("PSJBCMA5",$J,PSGP,PSGORD,LNTXT))
Q:'LNTXT D
"RTN","PSGVW",62,0)
..I LNTXT=1 W !,"Special Instructions: (see below)"
"RTN","PSGVW",63,0)
..W !,$G(^TMP("PSJBCMA5",$J,PSGP,PSGORD,LNTXT))
"RTN","PSGVW",64,0)
W !?48,"Units",?56,"Units",?64,"Inactive",!," Dispense
Drugs",?43,"U/D",?48,"Disp'd",?56,"Ret'd",?64,"Date",!,FL,$E(FL,1,10)
"RTN","PSGVW",65,0)
; the naked reference on the line below refers to the full reference created by indirect reference to
F_ON, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
"RTN","PSGVW",66,0)
F X=0:0 S X=$O(@(F_"1,"_X_")")) Q:'X S DRG=$G(^(X,0)) I DRG]"" D ;
"RTN","PSGVW",67,0)
.S
UD=$P(DRG,"^",2),D=$P(DRG,"^",6)+$P(DRG,"^",10)+$P(DRG,"^",12),R=+$P(DRG,"^",7),Y=$P(DRG,"^",3)
,DRG=$P(DRG,"^") I Y S Y=$E($$ENDTC^PSGMI(Y),1,8)
"RTN","PSGVW",68,0)
.W !?1,$$ENDDN^PSGMI(DRG),?43,$S(UD:UD,1:1),?48,D,?56,R W:Y ?64,Y Q
"RTN","PSGVW",69,0)
; the naked reference on the two lines below refers to the full reference created by indirect reference to
F_ON, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
"RTN","PSGVW",70,0)
I $O(@(F_"12,0)")) W !!,"Provider Comments:" F Q=0:0 S Q=$O(@(F_"12,"_Q_")")) Q:'Q N Y S Y=^(Q,0)
W !,Y
"RTN","PSGVW",71,0)
I $O(@(F_"3,0)")) W !!,"Comments:" F Q=0:0 S Q=$O(@(F_"3,"_Q_")")) Q:'Q W !,^(Q,0)
"RTN","PSGVW",72,0)
ACTFLG W ! S AT="",Y="12,13,D,18,19,H1,22,23,H0,15,16,R" F X=1:3:12 I
$P(ND4,"^",$P(Y,",",X)),$P(ND4,"^",$P(Y,",",X+1)) S AT=$P(Y,",",X+2) Q
"RTN","PSGVW",73,0)
I AT="",'$P(ND4,"^",$S($P(PSJSYSU,";",3)>1:3,1:1)) S
AT="V"_$S($P(ND4,"^",18):"H1",$P(ND4,"^",22):"H0",$P(ND4,"^",15):"R",1:"")
"RTN","PSGVW",74,0)
W:AT]"" !,"ORDER ",$S(AT["V":"NOT VERIFIED"_$S($P(AT,"V",2)="":"",1:" ("_$S(AT["H1":"ON
HOLD",AT["H0":"OFF HOLD",1:"RENEWAL")_")"),1:"MARKED TO BE
"_$S(AT["D":"CANCELLED",AT["H1":"PLACED ON HOLD",AT["H0":"TAKEN OFF OF HOLD",1:"RENEWED"))
"RTN","PSGVW",75,0)
I AT'["V",AT["H1",$D(^PS(55,PSGP,5.1)) S AT=^(5.1) I $P(AT,"^",7),$P(AT,"^",10)]"" W "
(",$P(AT,"^",10),")"
"RTN","PSGVW",76,0)
W !,"Self Med: " I SM W "SELF MED" W:HSM " (HOSPITAL SUPPLIED)"
"RTN","PSGVW",77,0)
I 'SM&('HSM) W "NO"
"RTN","PSGVW",78,0)
W !!,"Entry By: ",$$ENNPN^PSGMI(EB),?52,"Entry Date: ",LID
"RTN","PSGVW",79,0)
I $G(PSGLRN) W !,"Renewed By: "_$$ENNPN^PSGMI($P(PSGLRN,"^",2))
"RTN","PSGVW",80,0)
W:DRGI !!?3,"(THE ORDERABLE ITEM IS CURRENTLY LISTED AS INACTIVE.)" I PRI W:'DRGI ! W
!?3,"(PROVIDER IS CURRENTLY LISTED AS INACTIVE.)"
"RTN","PSGVW",81,0)
;
"RTN","PSGVW",82,0)
DONE ;
"RTN","PSGVW",83,0)
K ^TMP("PSJBCMA5",$J)
"RTN","PSGVW",84,0)
K
AND,D,DRG1,DRG2,AT,DO,DRG,EB,F,FD,FL,HSM,INS,LID,MR,ND4,OD,PN,PR,PSGID,PSGOD,R,SCH,SCT,SI,SI
G,SM,ST,STD,UD,X,XU,Y,RT Q
"RTN","PSGVW",85,0)
Q
"RTN","PSIVACT")
0^9^B31395934^B31395349
"RTN","PSIVACT",1,0)
PSIVACT ;BIR/PR,MLM - UPDATE ORDER STATUS AFTER PATIENT SELECTION ;Jul 02, 2018@09:29
"RTN","PSIVACT",2,0)
;;5.0;INPATIENT MEDICATIONS;**15,38,58,110,181,275,304,373**;16 DEC 97;Build 3
"RTN","PSIVACT",3,0)
;
"RTN","PSIVACT",4,0)
; Reference to ^PS(55 is supported by DBIA 2191
"RTN","PSIVACT",5,0)
;
"RTN","PSIVACT",6,0)
ENNA ; Inpatient entry point.
"RTN","PSIVACT",7,0)
D:$D(XRTL) T0^%ZOSV
"RTN","PSIVACT",8,0)
D NOW^%DTC S PSFDT=%,PS=0 D L D:'$G(PSIVRD) PEND
"RTN","PSIVACT",9,0)
I $D(XRT0) S XRTN="PSIVACT" D T1^%ZOSV
"RTN","PSIVACT",10,0)
Q
"RTN","PSIVACT",11,0)
;
"RTN","PSIVACT",12,0)
ENNB ; Ask profile type, gather orders.
"RTN","PSIVACT",13,0)
D NOW^%DTC S PSFDT=%,PS=0 K ^TMP("PSIV",$J),^TMP("PSJPRO",$J)
"RTN","PSIVACT",14,0)
S PSIVNV=$S(+PSJSYSU=1:"ANIV",+PSJSYSU=3:"APIV",1:"")
"RTN","PSIVACT",15,0)
D @P("PT") D:'$G(PSIVRD) PEND
"RTN","PSIVACT",16,0)
I P("PT")="L",$D(XRT0) S XRTN="PSIVACT" D T1^%ZOSV
"RTN","PSIVACT",17,0)
Q
"RTN","PSIVACT",18,0)
;
"RTN","PSIVACT",19,0)
L ; Long profile
"RTN","PSIVACT",20,0)
S:'$D(PSJSYSU) PSJSYSU=""
"RTN","PSIVACT",21,0)
F ON=0:0 K Y S ON=$O(^PS(55,DFN,"IV",+ON)) Q:'ON D SETP
"RTN","PSIVACT",22,0)
Q
"RTN","PSIVACT",23,0)
;
"RTN","PSIVACT",24,0)
S ; Short profile.
"RTN","PSIVACT",25,0)
S PSJDCEXP=$$RECDCEXP^PSJP()
"RTN","PSIVACT",26,0)
I '+$P(PSJDCEXP,U,2) S $P(PSJDCEXP,U,2)=PSFDT
"RTN","PSIVACT",27,0)
F PSIVDT=$P($G(PSJDCEXP),U,2):0 S PSIVDT=$O(^PS(55,DFN,"IV","AIS",PSIVDT))
Q:'PSIVDT!(PSIVDT'=+PSIVDT) F ON=0:0 S ON=$O(^PS(55,DFN,"IV","AIS",PSIVDT,+ON)) Q:'ON S
ON=ON_"V",P(17)=$P($G(^PS(55,DFN,"IV",+ON,0)),U,17) D ACTO
"RTN","PSIVACT",28,0)
I +PSJSYSU=3 S PSIVNV="APIV" D NVACT K PSIVNV
"RTN","PSIVACT",29,0)
Q
"RTN","PSIVACT",30,0)
;
"RTN","PSIVACT",31,0)
NVACT ; Non-verified but have active status
"RTN","PSIVACT",32,0)
NEW ON S PSGP=DFN ;added PSGP #373
"RTN","PSIVACT",33,0)
F ON=0:0 S ON=$O(^PS(55,PSIVNV,DFN,ON)) Q:'ON D
"RTN","PSIVACT",34,0)
. N CLIN,CLINSORT,SORT,PSIVSTAT,CLINSORT S PSIVSTAT="A"
"RTN","PSIVACT",35,0)
. S CLIN=$$CLINIC^PSJO1(PSGP,ON) I $L(CLIN)>1 S CLINSORT=$$CLINSORT^PSJO1("A") S
PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^A"
"RTN","PSIVACT",36,0)
. I $P($G(^PS(55,DFN,"IV",ON,0)),U,17)="E",($P($G(^(.2)),U,4)="D") S
^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)=""
"RTN","PSIVACT",37,0)
Q
"RTN","PSIVACT",38,0)
;
"RTN","PSIVACT",39,0)
PEND ; Get pending and non-verified orders from 53.1
"RTN","PSIVACT",40,0)
N PSJCOM,PSJCOM1 S (PSJCOM,PSJCOM1)=0,PSGP=DFN ;added PSGP #373
"RTN","PSIVACT",41,0)
F ON=0:0 S ON=$O(^PS(53.1,"AS","P",DFN,ON)) Q:'ON D S PSJCOM1=PSJCOM
"RTN","PSIVACT",42,0)
. NEW X S X=$P($G(^PS(53.1,ON,.2)),U,4),X=$S(X="S":1,X="A":2,X="R":3,X="P":4,1:5)
"RTN","PSIVACT",43,0)
. S PSJCOM=$P($G(^PS(53.1,ON,.2)),U,8) I PSJCOM Q:'$$COMCHK^PSJO1(PSJCOM,2)
Q:PSJCOM=PSJCOM1
"RTN","PSIVACT",44,0)
. N CLIN,CLINSORT,SORT,PSIVSTAT,CLINSORT S PSIVSTAT=$S('PSJCOM:"P",1:"PD")
"RTN","PSIVACT",45,0)
. S CLIN=$$CLINIC^PSJO1(PSGP,ON_"P") I $L(CLIN)>1 S CLINSORT=$$CLINSORT^PSJO1("P") S
PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT
"RTN","PSIVACT",46,0)
. I $G(^PS(53.1,ON,0)),$P(^PS(53.1,ON,0),U,4)'="U" S ^TMP("PSIV",$J,PSIVSTAT,X_9999999999-ON)=""
"RTN","PSIVACT",47,0)
F ON=0:0 S ON=$O(^PS(53.1,"AS","N",DFN,ON)) Q:'ON D S PSJCOM1=PSJCOM
"RTN","PSIVACT",48,0)
. NEW X S X=$P($G(^PS(53.1,ON,.2)),U,4),X=$S(X="S":1,X="A":2,X="R":3,X="P":4,1:5)
"RTN","PSIVACT",49,0)
. S PSJCOM=$P($G(^PS(53.1,ON,.2)),U,8) I PSJCOM Q:'$$COMCHK^PSJO1(PSJCOM,2)
Q:PSJCOM=PSJCOM1
"RTN","PSIVACT",50,0)
. N CLIN,PSIVSTAT,CLINSORT,SORT S PSIVSTAT=$S('PSJCOM:"N",1:"ND")
"RTN","PSIVACT",51,0)
. S CLIN=$$CLINIC^PSJO1(PSGP,ON_"P") I (CLIN]"") S CLINSORT=$$CLINSORT^PSJO1("P") S
PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_$S('PSJCOM:"N",1:"ND")
"RTN","PSIVACT",52,0)
. I $G(^PS(53.1,ON,0)),$P(^PS(53.1,ON,0),U,4)'="U" S ^TMP("PSIV",$J,PSIVSTAT,X_9999999999-ON)=""
"RTN","PSIVACT",53,0)
.; S:$P(^PS(53.1,ON,0),U,4)'="U" ^TMP("PSIV",$J,"P",X_9999999999-ON)=""
"RTN","PSIVACT",54,0)
;
"RTN","PSIVACT",55,0)
QUIT ; Kill and exit.
"RTN","PSIVACT",56,0)
K PSIVCWD,PSIVFLAG,PSIVWD,PSDFN,PSON1,PSFDT,YHOLD,JJ,XHOLD
"RTN","PSIVACT",57,0)
Q
"RTN","PSIVACT",58,0)
;
"RTN","PSIVACT",59,0)
SETP ; Get partial P array,
"RTN","PSIVACT",60,0)
S ON=ON_"V",Y=$G(^PS(55,DFN,"IV",+ON,0)) F X=2,3,17,21 S P(X)=$P(Y,U,X)
"RTN","PSIVACT",61,0)
S P(2)=+P(2),P(3)=+P(3) S Y(P(2))="",Y(P(3))=""
"RTN","PSIVACT",62,0)
I P(2),P(3),P(17)'="P" D CHK
"RTN","PSIVACT",63,0)
Q
"RTN","PSIVACT",64,0)
;
"RTN","PSIVACT",65,0)
CHK ; Check if order is active or expired and save accordingly.
"RTN","PSIVACT",66,0)
N CLIN,PSIVSTAT,CLINSORT,SORT S PSIVSTAT="A",PSGP=DFN ;373 added PSGP
"RTN","PSIVACT",67,0)
S CLIN=$$CLINIC^PSJO1(PSGP,ON) I CLIN]"" S CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT) S
PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^A"
"RTN","PSIVACT",68,0)
S PS=PS+1 I P(17)="H" S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)="" Q
"RTN","PSIVACT",69,0)
I $O(Y(PSFDT))=P(3) D ACTO Q
"RTN","PSIVACT",70,0)
I $O(Y(PSFDT))="" D NACTO Q
"RTN","PSIVACT",71,0)
S:"ARO"[P(17) ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)="" S:"ED"[P(17)
^TMP("PSIV",$J,"X",9999999999-ON)="" S:"E"[P(17)
PSIVREA="A",$P(^PS(55,DFN,"IV",+ON,0),U,17)="A",PS("A",9999999999-ON)=""
"RTN","PSIVACT",72,0)
Q
"RTN","PSIVACT",73,0)
;
"RTN","PSIVACT",74,0)
ACTO ; Active orders
"RTN","PSIVACT",75,0)
;I "AE"[P(17) S ^TMP("PSIV",$J,"A",9999999999-ON)="" S:P(17)="E"
$P(^PS(55,DFN,"IV",+ON,0),U,17)="A" Q ;;mv-not sure why setting status back to "A"???
"RTN","PSIVACT",76,0)
N CLINSORT,SORT,CLIN,PSIVSTAT S PSIVSTAT="A",PSGP=DFN ;added PSGP #373
"RTN","PSIVACT",77,0)
S CLIN=$$CLINIC^PSJO1(PSGP,ON) I (CLIN]"") S CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT) S
PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^A"
"RTN","PSIVACT",78,0)
I ($P(PSIVSTAT,"^")="Cz") S:("DE"[P(17)) PSIVSTAT="RD" S ^TMP("PSIV",$J,PSIVSTAT,9999999999-
ON)="" Q
"RTN","PSIVACT",79,0)
I "A"[P(17) S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)="" Q
"RTN","PSIVACT",80,0)
I "HOR"[P(17) S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)="" Q
"RTN","PSIVACT",81,0)
I "DE"[P(17) S ^TMP("PSIV",$J,"RD",9999999999-ON)=""
"RTN","PSIVACT",82,0)
Q
"RTN","PSIVACT",83,0)
;
"RTN","PSIVACT",84,0)
NACTO ; Inactive orders
"RTN","PSIVACT",85,0)
;I "AER"[P(17) S ^TMP("PSIV",$J,"X",9999999999-ON)="" I "AR"[P(17) S
$P(^PS(55,DFN,"IV",+ON,0),U,17)="E" D EXPIR^PSIVOE Q
"RTN","PSIVACT",86,0)
N CLIN,PSIVSTAT,SORT,CLINSORT S PSIVSTAT="",PSGP=DFN ;added PSGP #373
"RTN","PSIVACT",87,0)
S CLIN=$$CLINIC^PSJO1(PSGP,ON)
"RTN","PSIVACT",88,0)
I "AER"[P(17) D
"RTN","PSIVACT",89,0)
. Q:$P(^PS(55,DFN,"IV",+ON,0),U,3)="" S PSIVSTAT="A"
"RTN","PSIVACT",90,0)
. I +PSJSYSU=3,($P($G(^PS(55,DFN,"IV",+ON,.2)),U,4)="D"),'+$P($G(^(4)),U,4) D Q
"RTN","PSIVACT",91,0)
.. I (CLIN]"") S CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT) S
PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT
"RTN","PSIVACT",92,0)
.. S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)=""
"RTN","PSIVACT",93,0)
. S PSIVSTAT="X" S:(CLIN]"") CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT) S:($G(CLINSORT)]"")
PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT D
"RTN","PSIVACT",94,0)
.. S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)=""
"RTN","PSIVACT",95,0)
I "AR"[P(17) S $P(^PS(55,DFN,"IV",+ON,0),U,17)="E" D EXPIR^PSIVOE
"RTN","PSIVACT",96,0)
I "OD"[P(17) S PSIVSTAT="X" S:(CLIN]"") CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT) S:($G(CLINSORT)]"")
PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT D
"RTN","PSIVACT",97,0)
.S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)=""
"RTN","PSIVACT",98,0)
Q
"RTN","PSIVACT",99,0)
;
"RTN","PSIVACT",100,0)
DCOR ; Auto-cancel IV orders
"RTN","PSIVACT",101,0)
;NEED TO NEW VARIABLES LATER.
"RTN","PSIVACT",102,0)
NEW
DA,DIR,DG,ON,ON55,P,PSIVAC,PSIVACT,PSIVLN,PSIVREA,PSIVRES,PSGALO,PSGP,PSJDCDT,PSJIVDCF,PSJIV
ON,PSJIVORF,PSJORF,VA,VADM,VAERR
"RTN","PSIVACT",103,0)
S PSGP=DFN,PSIVRES="Auto DC due to Surgery Package"
"RTN","PSIVACT",104,0)
D NOW^%DTC S PSJDCDT=+%
"RTN","PSIVACT",105,0)
D ENIV^PSJADT0
"RTN","PSIVACT",106,0)
Q
"RTN","PSIVEDT1")
0^10^B119441864^B119441864
"RTN","PSIVEDT1",1,0)
PSIVEDT1 ;BIR/MLM - EDIT IV ORDER (CONT) ;Jul 02, 2018@09:31
"RTN","PSIVEDT1",2,0)
;;5.0;INPATIENT MEDICATIONS;**3,7,41,47,50,64,58,116,110,111,113,267,279,305,194,373**;16 DEC
97;Build 3
"RTN","PSIVEDT1",3,0)
;
"RTN","PSIVEDT1",4,0)
; Reference to ^PS(55 is supported by DBIA# 2191.
"RTN","PSIVEDT1",5,0)
; Reference to ^PS(51.1 is supported by DBIA# 2177.
"RTN","PSIVEDT1",6,0)
;
"RTN","PSIVEDT1",7,0)
10 ; Start Date
"RTN","PSIVEDT1",8,0)
D:'P(2)&P("IVRM")!($G(PSJREN)) ENT^PSIVCAL
"RTN","PSIVEDT1",9,0)
A10 I $G(P("RES"))="R" I $G(ON)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q
"RTN","PSIVEDT1",10,0)
. Q:'$G(PSIVRENW) W !!?5,"This is a Renewal Order. Start Date may not be edited at this point." D
PAUSE^VALM1
"RTN","PSIVEDT1",11,0)
I $G(ON)["V"!($G(ON)["U") I $$COMPLEX^PSJOE(DFN,ON) D Q
"RTN","PSIVEDT1",12,0)
.Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Start Date may not be edited at this point." D
PAUSE^VALM1
"RTN","PSIVEDT1",13,0)
S Y=P(2) X ^DD("DD") W !,"START DATE/TIME: "_$S(Y]"":Y_"// ",1:"") R X:DTIME S:'$T X=U S:X=U
DONE=1 I $E(X)=U!(P(2)&X="") Q
"RTN","PSIVEDT1",14,0)
I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS G 10
"RTN","PSIVEDT1",15,0)
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S F1=53.1,F2=10 S:X="@" X="?" D ENHLP^PSIVORC1 G
A10
"RTN","PSIVEDT1",16,0)
K %DT S:X="" X=P(2) S %DT="ERTX" D ^%DT K %DT G:Y'>0 A10
"RTN","PSIVEDT1",17,0)
I $G(P("RES"))="R",(+Y<+$P($G(^PS(55,DFN,"IV",+$G(P("OLDON")),0)),U,2)) D G 10
"RTN","PSIVEDT1",18,0)
.; naked ref below refers to line above
"RTN","PSIVEDT1",19,0)
.S Y=$P(^(0),U,2) X ^DD("DD") W $C(7),!!,"Start date of order being renewed is ",Y,".",!,"Start date of
renewal order must be AFTER start date of order being renewed.",!
"RTN","PSIVEDT1",20,0)
S X1=$G(P("LOG")),X2=-7 D C^%DTC I +Y<X W $C(7),!!,"Start date/time may not be entered prior to 7
days from the order's LOGIN DATE.",! G A10
"RTN","PSIVEDT1",21,0)
; RBD PSJ*5*373 Soft stop when Start Date more than 7 days after Order's LOGIN DATE
"RTN","PSIVEDT1",22,0)
S X1=$G(P("LOG")),X2=+7 D C^%DTC
"RTN","PSIVEDT1",23,0)
I +Y>X W !!,$C(7),"Start date/time should not be entered for more than 7 days after the",!,"order's
LOGIN DATE.",! K DIR D WAIT^VALM1
"RTN","PSIVEDT1",24,0)
S P(2)=+Y,PSGSDX=1
"RTN","PSIVEDT1",25,0)
Q
"RTN","PSIVEDT1",26,0)
;
"RTN","PSIVEDT1",27,0)
25 ; Stop Date
"RTN","PSIVEDT1",28,0)
G:$D(PSGFDX) A25
"RTN","PSIVEDT1",29,0)
I P("IVRM")]"",$S(P(3)<P(2):1,$G(PSIVAC)["E":0,1:1) S
PSIVSITE=$G(^PS(59.5,+P("IVRM"),1)),$P(PSIVSITE,"^",20,21)=$G(^PS(59.5,+P("IVRM"),5)) D
ENSTOP^PSIVCAL
"RTN","PSIVEDT1",30,0)
A25 I $G(ON)["V"!($G(ON)["U") I $$COMPLEX^PSJOE(DFN,ON) D Q
"RTN","PSIVEDT1",31,0)
.Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Stop Date may not be edited at this point." D
PAUSE^VALM1
"RTN","PSIVEDT1",32,0)
S Y=P(3) X ^DD("DD") W !,"STOP DATE/TIME: "_$S(Y]"":Y_"// ",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1
Q:X=""&P(2) I $E(X)=U!(X=""&P(2)) Q
"RTN","PSIVEDT1",33,0)
I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS G 25
"RTN","PSIVEDT1",34,0)
I X="@"!(X["?") W $C(7)," (Required)" S F1=53.1,F2=25,X="?" D ENHLP^PSIVORC1 G A25
"RTN","PSIVEDT1",35,0)
K %DT S:X="" X=$G(Y) S:X="" X=P(3) S %DT="ERTX" D:X'=+X ^%DT
"RTN","PSIVEDT1",36,0)
I X=+X,X>0,X'>2000000 G A25:'$$ENDL^PSGDL(P(9),X) D ENDL^PSIVSP
"RTN","PSIVEDT1",37,0)
D DOSE
"RTN","PSIVEDT1",38,0)
I $G(X)="" S X=Y
"RTN","PSIVEDT1",39,0)
I $G(X)="" S X=P(3)
"RTN","PSIVEDT1",40,0)
I $G(Z)]"",Z>X D G A25
"RTN","PSIVEDT1",41,0)
. W !,"There is no administration time that falls between the Start Date/Time"
"RTN","PSIVEDT1",42,0)
. W !,"and Stop Date/Time.",!
"RTN","PSIVEDT1",43,0)
S X=Y S:Y<1!Y'["." X="" G:Y'>0 A25
"RTN","PSIVEDT1",44,0)
; RBD PSJ*5*373 Hard stop when Stop Date more than 367 days after Start Date
"RTN","PSIVEDT1",45,0)
S X1=+Y,X2=P(2) D ^%DTC
"RTN","PSIVEDT1",46,0)
I X>367 W $C(7),!!?13,"*** STOP DATE cannot be more than 367 days from START DATE ***",! G A25
"RTN","PSIVEDT1",47,0)
S P(3)=+Y,PSGFDX=1
"RTN","PSIVEDT1",48,0)
Q
"RTN","PSIVEDT1",49,0)
;
"RTN","PSIVEDT1",50,0)
26 ; Schedule
"RTN","PSIVEDT1",51,0)
I $G(P("RES"))="R" I $G(ON)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q
"RTN","PSIVEDT1",52,0)
. Q:'$G(PSIVRENW) W !!?5,"This is a Renewal Order. Schedule may not be edited at this point." D
PAUSE^VALM1
"RTN","PSIVEDT1",53,0)
I $G(ON)["V"!($G(ON)["U") I $$COMPLEX^PSJOE(DFN,ON) D Q
"RTN","PSIVEDT1",54,0)
.Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Schedule may not be edited at this point." D
PAUSE^VALM1
"RTN","PSIVEDT1",55,0)
W !,"SCHEDULE: ",$S(P(9)]"":P(9)_"// ",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(X="") Q
"RTN","PSIVEDT1",56,0)
I X="@" D DEL^PSIVEDRG S:%=1 P(9)="" G 26
"RTN","PSIVEDT1",57,0)
I '$$SCHREQ^PSJLIVFD(.P) S P(7)="" I $P(X,"@",2)=0 D G 26
"RTN","PSIVEDT1",58,0)
.W $C(7),!!?2,"'@0' is not permitted for Continuous IV's",!
"RTN","PSIVEDT1",59,0)
I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS G 26
"RTN","PSIVEDT1",60,0)
;*194 Allow multi-word schedules
"RTN","PSIVEDT1",61,0)
I X?1."?"!($L(X)>22)!($L(X," ")>$S(X["PRN":4,1:3)) S F1=55.01,F2=.09 D ENHLP^PSIVORC1 G 26
"RTN","PSIVEDT1",62,0)
S CHG=0 I P(9)]"",X'=P(9) S CHG=1
"RTN","PSIVEDT1",63,0)
S P(7)="" K PSGOES D EN^PSIVSP S:XT<0 X="" I $G(X)="" W $C(7),"??" G 26
"RTN","PSIVEDT1",64,0)
I CHG D
"RTN","PSIVEDT1",65,0)
. S P(9)=X,P(11)=Y,P(15)=XT
"RTN","PSIVEDT1",66,0)
. I $$ODD^PSGS0(P(15)) S P(11)=""
"RTN","PSIVEDT1",67,0)
. W !!?5,"This change in schedule also changes the Administration Times and Schedule Type of this
order."
"RTN","PSIVEDT1",68,0)
. S DIR("A")="Enter RETURN to continue or '^' to exit:"
"RTN","PSIVEDT1",69,0)
. D PAUSE^VALM1
"RTN","PSIVEDT1",70,0)
K CHG
"RTN","PSIVEDT1",71,0)
Q
"RTN","PSIVEDT1",72,0)
;
"RTN","PSIVEDT1",73,0)
39 ; Admin Times
"RTN","PSIVEDT1",74,0)
S ORIG=$G(P(11))
"RTN","PSIVEDT1",75,0)
A39 I $G(P("RES"))="R" I $G(ON)["P",($P($G(^PS(53.1,+ON,0)),"^",24)="R") D Q
"RTN","PSIVEDT1",76,0)
. Q:'$G(PSIVRENW) W !!?5,"This is a Renewal Order. Administration times may not be edited at this
point." D PAUSE^VALM1
"RTN","PSIVEDT1",77,0)
I $G(ON)["V"!($G(ON)["U") I $$COMPLEX^PSJOE(DFN,ON) D Q
"RTN","PSIVEDT1",78,0)
.Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Admin Times may not be edited at this point." D
PAUSE^VALM1
"RTN","PSIVEDT1",79,0)
I $G(P(9))=""!($G(P(9))[" PRN")!($G(P(9))="PRN") Q ;No schedule or PRN schedule
"RTN","PSIVEDT1",80,0)
I $$ODD^PSGS0(P(15)) S P(11)="" Q
"RTN","PSIVEDT1",81,0)
W !,"ADMINISTRATION TIMES: ",$S(P(11)]"":P(11)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I
'($G(P(15))="D"&'DONE) I $E(X)=U S (X,P(11))=ORIG Q
"RTN","PSIVEDT1",82,0)
I X="",P(11)]"" S X=P(11)
"RTN","PSIVEDT1",83,0)
I ($G(P(15))="D"!($G(P(9))["@"))&('$G(X)!(X["@")) W $C(7)," ??" S X="?" W:(P(15)="D"!(X["@")) !,"This
is a 'DAY OF THE WEEK' schedule and MUST have admin times." G A39
"RTN","PSIVEDT1",84,0)
I X="@" D DEL^PSIVEDRG S:%=1 P(11)="" G A39
"RTN","PSIVEDT1",85,0)
I X?1."?" D ENHLP^PSGOEM(53.1,39) G A39
"RTN","PSIVEDT1",86,0)
I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS G A39
"RTN","PSIVEDT1",87,0)
I $G(P(15))'="D",$G(P(15))'="P",'$$ONCALL(P(9)) D TIMES I '$D(X) G A39
"RTN","PSIVEDT1",88,0)
K:X[""""!($A(X)=45) X W:$G(X)="^"!('$D(X)) $C(7)," ??" G:$G(X)="^"!('$D(X)) A39 S P(11)=X
D:$G(PSIVCAL) ENT^PSIVCAL,ENSTOP^PSIVCAL K PSIVCAL
"RTN","PSIVEDT1",89,0)
Q
"RTN","PSIVEDT1",90,0)
;
"RTN","PSIVEDT1",91,0)
59 ; Infusion Rate
"RTN","PSIVEDT1",92,0)
;*305
"RTN","PSIVEDT1",93,0)
N P8BADDEF S P8BADDEF=0 K PSJEXMSG
"RTN","PSIVEDT1",94,0)
I $G(P("RES"))="R" I $G(ON)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q
"RTN","PSIVEDT1",95,0)
. Q:'$G(PSIVRENW) W !!?5,"This is a Renewal Order. Infusion Rate may not be edited at this point." D
PAUSE^VALM1
"RTN","PSIVEDT1",96,0)
W !,"INFUSION RATE: ",$S(P(8)]"":$P(P(8),"@")_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I
$S($E(X)=U:1,X]"":0,1:P(8)]"") D:'$G(DONE) EXPINF(.X) D:'$G(DONE) NUMLAB(.P) G:$G(P8BADDEF) 59 Q
"RTN","PSIVEDT1",97,0)
S
X=$TR(X,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127))
; Strip out control characters
"RTN","PSIVEDT1",98,0)
I ((P(4)="P")!((P(4)="C")&(P(23)="P"))!(("C^S"[P(4))&(P(5)=1)))&(X["@") D G 59
"RTN","PSIVEDT1",99,0)
.W $C(7),!!?2,"'@' is not permitted for Intermittent IV's",!
"RTN","PSIVEDT1",100,0)
I (X["^") D G 59
"RTN","PSIVEDT1",101,0)
.W $C(7),!!?2,"'^' is not permitted",!
"RTN","PSIVEDT1",102,0)
I X=""&((P(4)="P")!((P(4)="C")&(P(23)="P"))!(("C^S"[P(4))&(P(5)=1))) Q
"RTN","PSIVEDT1",103,0)
I X="@" D DEL^PSIVEDRG S:%=1 P(8)="" G 59
"RTN","PSIVEDT1",104,0)
I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS G 59
"RTN","PSIVEDT1",105,0)
I X["?" S F1=53.1,F2=59 D ENHLP^PSIVORC1 G 59
"RTN","PSIVEDT1",106,0)
D EXPINF(.X)
"RTN","PSIVEDT1",107,0)
I ($L(X)>30!($L(X)=1)),(X'?1N) D G 59
"RTN","PSIVEDT1",108,0)
.W $C(7),!!?3,"Free text entries must contain a minimum of 2 characters",!?3,"and a maximum of 30
characters",!
"RTN","PSIVEDT1",109,0)
I X]"" D ENI^PSIVSP W:'$D(X) $C(7)," ??" G:'$D(X) 59 S P(8)=X
"RTN","PSIVEDT1",110,0)
I P(8)="" W $C(7),!!,"An infusion rate must be entered!" G 59
"RTN","PSIVEDT1",111,0)
D NUMLAB(.P)
"RTN","PSIVEDT1",112,0)
Q
"RTN","PSIVEDT1",113,0)
;
"RTN","PSIVEDT1",114,0)
NUMLAB(P) ; Prompt for Number of Labels
"RTN","PSIVEDT1",115,0)
N PSJILBS
"RTN","PSIVEDT1",116,0)
NUMLAB2 ; Loop ;*305
"RTN","PSIVEDT1",117,0)
; Quit if no Infusion Rate
"RTN","PSIVEDT1",118,0)
Q:($G(P(8))="")
"RTN","PSIVEDT1",119,0)
I ((P(4)="P")!((P(4)="C")&(P(23)="P"))!(("C^S"[P(4))&(P(5)=1))) D Q
"RTN","PSIVEDT1",120,0)
.I $G(X)="",$G(P(8))["@" S P(8)=$P(P(8),"@")
"RTN","PSIVEDT1",121,0)
K DIR S PSJILBS=$P($G(P(8)),"@",2) S:'(PSJILBS?1.N) PSJILBS=$G(P("NUMLBL")) I $G(PSJILBS)?1.N S
DIR("B")=PSJILBS
"RTN","PSIVEDT1",122,0)
D NLBHLP(1)
"RTN","PSIVEDT1",123,0)
S DIR(0)="FAO",DIR("A")="NUMBER OF LABELS PER DAY: " D ^DIR Q:X="^"
"RTN","PSIVEDT1",124,0)
I X="@" D DEL^PSIVEDRG S:%=1 P("NUMLBL")="",P(8)=$P(P(8),"@") G NUMLAB2
"RTN","PSIVEDT1",125,0)
I X?1."?" D NLBHLP G NUMLAB2
"RTN","PSIVEDT1",126,0)
I X?1.2N S P("NUMLBL")=+X,P(8)=$P(P(8),"@")_"@"_P("NUMLBL") Q
"RTN","PSIVEDT1",127,0)
I X="",(P(8)'?1N.N.1".".1N1" ml/hr") D G NUMLAB2
"RTN","PSIVEDT1",128,0)
.W $C(7),!!,"Number of Labels is required for continuous IV's with free text Infusion Rate.",!
"RTN","PSIVEDT1",129,0)
Q:X=""
"RTN","PSIVEDT1",130,0)
I X'?1.2N D G NUMLAB2
"RTN","PSIVEDT1",131,0)
.W $C(7),!!,"Type a number between 0 and 99, 0 decimal digits",!
"RTN","PSIVEDT1",132,0)
Q
"RTN","PSIVEDT1",133,0)
;
"RTN","PSIVEDT1",134,0)
63 ; Remarks
"RTN","PSIVEDT1",135,0)
N DIR S X="",DIR(0)="53.1,63" S:P("REM")]"" DIR("B")=P("REM") D ^DIR I X="^"!$D(DTOUT) S DONE=1 Q
"RTN","PSIVEDT1",136,0)
I X="@" D DEL^PSIVEDRG S:%=1 P("REM")="" G 63
"RTN","PSIVEDT1",137,0)
I X]"",$E(X)'="^" S P("REM")=X
"RTN","PSIVEDT1",138,0)
Q
"RTN","PSIVEDT1",139,0)
;
"RTN","PSIVEDT1",140,0)
64 ; Other Print Info
"RTN","PSIVEDT1",141,0)
N OPIMSG,PSJOPILN,PSJOPIT,PSJTMPTX,TMPLIN,PSJOVRMX
"RTN","PSIVEDT1",142,0)
S PSJOPILN=$$EDITOPI^PSJBCMA5(DFN) S OPIMSG="Instructions too long. See Order View or BCMA for
full text."
"RTN","PSIVEDT1",143,0)
S PSJTMPTX="",PSJOVRMX=0
"RTN","PSIVEDT1",144,0)
S TMPLIN=0 F S TMPLIN=$O(^PS(53.45,$G(PSJSYSP),6,TMPLIN)) Q:'TMPLIN!PSJOVRMX D
"RTN","PSIVEDT1",145,0)
.S:($L(PSJTMPTX)+$L($G(^PS(53.45,$G(DUZ),6,TMPLIN,0))))>60 PSJOVRMX=1 Q:$G(PSJOVRMX) D
"RTN","PSIVEDT1",146,0)
..S PSJTMPTX=$G(PSJTMPTX)_$S($L($G(PSJTMPTX)):" ",1:"")_$G(^PS(53.45,$G(DUZ),6,TMPLIN,0))
"RTN","PSIVEDT1",147,0)
S PSJTMPTX=$S($G(PSJOVRMX):OPIMSG,1:$G(PSJTMPTX))
"RTN","PSIVEDT1",148,0)
S P("OPI")=PSJTMPTX I (PSJOPILN>0) S P("OPI")=$$ENBCMA^PSJUTL("V")
"RTN","PSIVEDT1",149,0)
Q
"RTN","PSIVEDT1",150,0)
;
"RTN","PSIVEDT1",151,0)
ORFLDS ; Display OE/RR fields during edit.
"RTN","PSIVEDT1",152,0)
D FULL^VALM1
"RTN","PSIVEDT1",153,0)
W !!,"Orderable Item: ",$P(P("PD"),U,2),!,"Give: ",$P(P("MR"),U,2)," ",P(9),!!
"RTN","PSIVEDT1",154,0)
Q
"RTN","PSIVEDT1",155,0)
;
"RTN","PSIVEDT1",156,0)
TIMES ;At least one admin time, not more than interval allows.
"RTN","PSIVEDT1",157,0)
I $G(P(15)) Q:$$ODD^PSGS0(P(15))
"RTN","PSIVEDT1",158,0)
I $G(P(15))="C"!$$CONTIN($G(P(9))) I '$$ONCALL($G(P(9))),X="" W !,"This order requires at least one
administration time." K X Q ;No times
"RTN","PSIVEDT1",159,0)
N H,I,MAX
"RTN","PSIVEDT1",160,0)
I $G(P(15))="O"!$$ONETIME($G(P(9))) I $L(X,"-")>1 W !," This is a One Time Order - only one
administration time is permitted." K X Q
"RTN","PSIVEDT1",161,0)
I $G(P(15))="O"!$$ONETIME($G(P(9))) Q ;Done validating One Time
"RTN","PSIVEDT1",162,0)
I $G(P(9))]"" S H=+$O(^PS(51.1,"B",P(9),0)) S I=$P($G(^PS(51.1,H,0)),"^",3)
"RTN","PSIVEDT1",163,0)
I +I=0 Q ;No frequency - can not check frequency related items
"RTN","PSIVEDT1",164,0)
S MAX=1440/I
"RTN","PSIVEDT1",165,0)
I MAX<1,$L(X,"-")>1 W !,"This order requires one administration time." K X Q
"RTN","PSIVEDT1",166,0)
I MAX'<1,$L(X,"-")>MAX W !,"The number of admin times entered is greater than indicated by the
schedule." K X Q ;Too many times
"RTN","PSIVEDT1",167,0)
I MAX'<1,$L(X,"-")<MAX D ;Too few times
"RTN","PSIVEDT1",168,0)
. W !,"The number of admin times entered is fewer than indicated by the schedule."
"RTN","PSIVEDT1",169,0)
. N X,DIR
"RTN","PSIVEDT1",170,0)
. D PAUSE^VALM1
"RTN","PSIVEDT1",171,0)
Q
"RTN","PSIVEDT1",172,0)
;
"RTN","PSIVEDT1",173,0)
DOSE ;Make certain at least one dose is given.
"RTN","PSIVEDT1",174,0)
N INFO,Y,PNINE
"RTN","PSIVEDT1",175,0)
S PNINE=P(9)
"RTN","PSIVEDT1",176,0)
S
INFO=$G(P(2))_U_$G(P(3))_U_$G(P(9))_U_$P($G(PSGZZND),"^",5)_U_$P($G(P("PD")),"^")_U_$G(P(11))
"RTN","PSIVEDT1",177,0)
I '$L($G(PSGP)) N PSGP S PSGP=""
"RTN","PSIVEDT1",178,0)
S Z=$$ENQ^PSJORP2(PSGP,INFO) ;Expected first dose.
"RTN","PSIVEDT1",179,0)
S P(9)=PNINE
"RTN","PSIVEDT1",180,0)
Q
"RTN","PSIVEDT1",181,0)
;
"RTN","PSIVEDT1",182,0)
ONCALL(SCHD) ; Check if a schedule is type On Call (all schedules with a given name must have the same
schedule type)
"RTN","PSIVEDT1",183,0)
N NXT,SCHARR
"RTN","PSIVEDT1",184,0)
S OCCHK=0
"RTN","PSIVEDT1",185,0)
Q:$G(SCHD)="" OCCHK
"RTN","PSIVEDT1",186,0)
Q:'$D(^PS(51.1,"APPSJ",SCHD)) OCCHK
"RTN","PSIVEDT1",187,0)
S NXT=0 F S NXT=$O(^PS(51.1,"APPSJ",SCHD,NXT)) Q:'NXT S TYP=$P($G(^PS(51.1,+NXT,0)),"^",5)
S:TYP]"" SCHARR(TYP)=""
"RTN","PSIVEDT1",188,0)
I '$D(SCHARR("OC")) S OCCHK=0 Q OCCHK
"RTN","PSIVEDT1",189,0)
I $O(SCHARR("OC"))]""!($O(SCHARR("OC"),-1)]"") S OCCHK=0 Q OCCHK
"RTN","PSIVEDT1",190,0)
I $D(SCHARR("OC")) S OCCHK=1
"RTN","PSIVEDT1",191,0)
Q OCCHK
"RTN","PSIVEDT1",192,0)
;
"RTN","PSIVEDT1",193,0)
ONETIME(SCHD) ; Check if a schedule is type On Call (all schedules with a given name must have the
same schedule type)
"RTN","PSIVEDT1",194,0)
N NXT,SCHARR
"RTN","PSIVEDT1",195,0)
S OCCHK=0
"RTN","PSIVEDT1",196,0)
Q:$G(SCHD)="" OCCHK
"RTN","PSIVEDT1",197,0)
Q:'$D(^PS(51.1,"APPSJ",SCHD)) OCCHK
"RTN","PSIVEDT1",198,0)
S NXT=0 F S NXT=$O(^PS(51.1,"APPSJ",SCHD,NXT)) Q:'NXT S TYP=$P($G(^PS(51.1,+NXT,0)),"^",5)
S:TYP]"" SCHARR(TYP)=""
"RTN","PSIVEDT1",199,0)
I '$D(SCHARR("O")) S OCCHK=0 Q OCCHK
"RTN","PSIVEDT1",200,0)
I $O(SCHARR("O"))]""!($O(SCHARR("O"),-1)]"") S OCCHK=0 Q OCCHK
"RTN","PSIVEDT1",201,0)
I $D(SCHARR("O")) S OCCHK=1
"RTN","PSIVEDT1",202,0)
Q OCCHK
"RTN","PSIVEDT1",203,0)
;
"RTN","PSIVEDT1",204,0)
CONTIN(SCHD) ; Check if a schedule is type On Call (all schedules with a given name must have the same
schedule type)
"RTN","PSIVEDT1",205,0)
N NXT,SCHARR
"RTN","PSIVEDT1",206,0)
S OCCHK=0
"RTN","PSIVEDT1",207,0)
Q:$G(SCHD)="" OCCHK
"RTN","PSIVEDT1",208,0)
Q:'$D(^PS(51.1,"APPSJ",SCHD)) OCCHK
"RTN","PSIVEDT1",209,0)
S NXT=0 F S NXT=$O(^PS(51.1,"APPSJ",SCHD,NXT)) Q:'NXT S TYP=$P($G(^PS(51.1,+NXT,0)),"^",5)
S:TYP]"" SCHARR(TYP)=""
"RTN","PSIVEDT1",210,0)
I '$D(SCHARR("C")) S OCCHK=0 Q OCCHK
"RTN","PSIVEDT1",211,0)
I $O(SCHARR("C"))]""!($O(SCHARR("C"),-1)]"") S OCCHK=0 Q OCCHK
"RTN","PSIVEDT1",212,0)
I $D(SCHARR("C")) S OCCHK=1
"RTN","PSIVEDT1",213,0)
Q OCCHK
"RTN","PSIVEDT1",214,0)
;
"RTN","PSIVEDT1",215,0)
NLBHLP(OUT) ; Help text for Number of Labels per day
"RTN","PSIVEDT1",216,0)
I OUT=1 D Q
"RTN","PSIVEDT1",217,0)
.S DIR("?",1)="Enter the # of labels per day that will be needed."
"RTN","PSIVEDT1",218,0)
.S DIR("?",2)=""
"RTN","PSIVEDT1",219,0)
.S DIR("?",3)="Example: 0 = 0 labels per day."
"RTN","PSIVEDT1",220,0)
.S DIR("?",4)=" 2 = 2 labels per day."
"RTN","PSIVEDT1",221,0)
.S DIR("?",5)="Note: Number of Labels per day is required for continuous IV orders"
"RTN","PSIVEDT1",222,0)
.S DIR("?",6)=" with free text Infusion Rate. Number of labels per day is not"
"RTN","PSIVEDT1",223,0)
.S DIR("?",7)=" permitted for Intermittent (IVPB) type orders; for Intermittent"
"RTN","PSIVEDT1",224,0)
.S DIR("?",8)=" orders, the schedule and administration time(s) will be used to"
"RTN","PSIVEDT1",225,0)
.S DIR("?")=" determine the number of labels needed."
"RTN","PSIVEDT1",226,0)
;
"RTN","PSIVEDT1",227,0)
W !,"Enter the # of labels per day that will be needed."
"RTN","PSIVEDT1",228,0)
W !,"Example: 0 = 0 labels per day."
"RTN","PSIVEDT1",229,0)
W !," 2 = 2 labels per day."
"RTN","PSIVEDT1",230,0)
W !!,"Note: Number of Labels per day is required for continuous IV orders"
"RTN","PSIVEDT1",231,0)
W !," with free text Infusion Rate. Number of labels per day is not"
"RTN","PSIVEDT1",232,0)
W !," permitted for Intermittent (IVPB) type orders; for Intermittent"
"RTN","PSIVEDT1",233,0)
W !," orders, the schedule and administration time(s) will be used to"
"RTN","PSIVEDT1",234,0)
W !," determine the number of labels needed."
"RTN","PSIVEDT1",235,0)
Q
"RTN","PSIVEDT1",236,0)
;
"RTN","PSIVEDT1",237,0)
EXPINF(P8,SILENT) ; Expand Infusion Rate
"RTN","PSIVEDT1",238,0)
;*305
"RTN","PSIVEDT1",239,0)
Q:$G(P8)!($G(PSJEXMSG)) N P8TMP S P8TMP=$$UP^XLFSTR($P(P8,"@"))
"RTN","PSIVEDT1",240,0)
N EXPANDED S EXPANDED="" D INFCHK^PSJLIVFD(P8TMP,.EXPANDED)
"RTN","PSIVEDT1",241,0)
I (EXPANDED=$P(P8,"@"))!(EXPANDED=P8TMP) Q
"RTN","PSIVEDT1",242,0)
S PSJEXMSG=1 I '$G(SILENT) W " Now expanding text"
"RTN","PSIVEDT1",243,0)
I P8["@" S $P(P8,"@")=EXPANDED
"RTN","PSIVEDT1",244,0)
I P8'["@" S P8=EXPANDED
"RTN","PSIVEDT1",245,0)
I '$G(SILENT) W:$G(PSJEXMSG) !," Input expanded to ",EXPANDED
"RTN","PSIVEDT1",246,0)
Q
"RTN","PSIVPRO")
0^11^B51389266^B51387613
"RTN","PSIVPRO",1,0)
PSIVPRO ;BIR/PR,MLM - PROFILE AN ORDER ;Jul 03, 2018@08:39
"RTN","PSIVPRO",2,0)
;;5.0;INPATIENT MEDICATIONS;**38,58,85,110,181,263,275,373**;16 DEC 97;Build 3
"RTN","PSIVPRO",3,0)
;33
"RTN","PSIVPRO",4,0)
; Reference to ^PS(55 is supported by DBIA 2191
"RTN","PSIVPRO",5,0)
;
"RTN","PSIVPRO",6,0)
;Needs DFN and ^TMP("PSIV",$J) array
"RTN","PSIVPRO",7,0)
N PSJCLNSV
"RTN","PSIVPRO",8,0)
S PSJLN=1,PSIVX2=0
"RTN","PSIVPRO",9,0)
S PSIVST=$O(^TMP("PSIV",$J,0)),X="",(PSIVON,PS)=0 D REACT I PSIVST]"" F PSIVX1=1:1 D PSIVST
Q:'PSIVON D PR
"RTN","PSIVPRO",10,0)
S ^TMP("PSJPRO",$J,0)=PSIVX2,VALMCNT=PSJLN-1
"RTN","PSIVPRO",11,0)
I $G(PSIVBR)="D ^PSIVOPT" S VALM("TITLE")="IV Order Entry"
"RTN","PSIVPRO",12,0)
E S VALM("TITLE")="IV Profile"
"RTN","PSIVPRO",13,0)
QUIT ; Kill and exit.
"RTN","PSIVPRO",14,0)
S ON=X K ADM,AL,DRG,GMRA,GMRAL,PSIVST,PSIVX1,PSIVX2,Y,NAD,N0,X3,X4,X5
"RTN","PSIVPRO",15,0)
Q
"RTN","PSIVPRO",16,0)
;
"RTN","PSIVPRO",17,0)
PSIVST ;
"RTN","PSIVPRO",18,0)
S PSIVON=$O(^TMP("PSIV",$J,PSIVST,PSIVON)) I 'PSIVON S PSIVST=$O(^TMP("PSIV",$J,PSIVST_"Z")) I
PSIVST]"" S PSIVON=$O(^TMP("PSIV",$J,PSIVST,0)) D HDL
"RTN","PSIVPRO",19,0)
Q
"RTN","PSIVPRO",20,0)
REACT ;
"RTN","PSIVPRO",21,0)
S PSJL="# Additive",PSJL=$$SETSTR^VALM1("Last fill",PSJL,32,9)
"RTN","PSIVPRO",22,0)
;S PSJL=$$SETSTR^VALM1("Type",PSJL,49,4),PSJL=$$SETSTR^VALM1(" Start Stop Stat",PSJL,54,19)
;#373
"RTN","PSIVPRO",23,0)
S PSJL=$$SETSTR^VALM1("Type",PSJL,49,4),PSJL=$$SETSTR^VALM1(" Start Stop Stat",PSJL,54,26)
;#373
"RTN","PSIVPRO",24,0)
;S PSJL=$$SETSTR^VALM1("Renew",PSJL,74,5) ;#373
"RTN","PSIVPRO",25,0)
D SETTMP^PSJLMPRI
"RTN","PSIVPRO",26,0)
HDL ; Display type heading.
"RTN","PSIVPRO",27,0)
S PSJL=""
"RTN","PSIVPRO",28,0)
D
ACL:($P(PSIVST,"^")'="Cz")&(PSIVST="A"),DPL:($P(PSIVST,"^")'="Cz")&(PSIVST="RD"),POL:($P(PSIVST,"^"
)'="Cz")&(PSIVST="P"),POCL:($P(PSIVST,"^")'="Cz")&(PSIVST="PD")
"RTN","PSIVPRO",29,0)
D
NVL:($P(PSIVST,"^")'="Cz")&(PSIVST="N"),NVCL:($P(PSIVST,"^")'="Cz")&(PSIVST="ND"),NOL:($P(PSIVST,"
^")'="Cz")&(PSIVST="X")
"RTN","PSIVPRO",30,0)
D
NOC:($P(PSIVST,"^")'="Cz")&(PSIVST=""),CLIN($P(PSIVST,"^",2)):($P(PSIVST,"^")="Cz"&($P(PSIVST,"^",2)'
=$G(PSJCLNSV))) S X=""
"RTN","PSIVPRO",31,0)
I ($P(PSIVST,"^")="Cz") S PSJCLNSV=$P(PSIVST,"^",2)
"RTN","PSIVPRO",32,0)
S PSJL=$E(PSJL,1,79) D SETTMP^PSJLMPRI
"RTN","PSIVPRO",33,0)
Q
"RTN","PSIVPRO",34,0)
;
"RTN","PSIVPRO",35,0)
PR ; Get & display order.
"RTN","PSIVPRO",36,0)
I ($P(PSIVST,"^")'="Cz") S (ON,ON55)=9999999999-
($S(PSIVST["P":$E(PSIVON,2,11),PSIVST["N":$E(PSIVON,2,11),1:PSIVON))_$S(PSIVST["P":"P",PSIVST["N":"
P",1:"V") D
"RTN","PSIVPRO",37,0)
.D
@$S(PSIVST["P":"GT531^PSIVORFA(DFN,ON)",PSIVST["N":"GT531^PSIVORFA(DFN,ON)",1:"GT55^PSIVO
RFB")
"RTN","PSIVPRO",38,0)
I ($P(PSIVST,"^")="Cz") S (ON,ON55)=9999999999-
($S($P(PSIVST,"^",4)["P":$E(PSIVON,2,11),$P(PSIVST,"^",4)["N":$E(PSIVON,2,11),1:PSIVON))_$S($P(PSIV
ST,"^",4)["P":"P",$P(PSIVST,"^",4)["N":"P",1:"V") D
"RTN","PSIVPRO",39,0)
.D
@$S($P(PSIVST,"^",4)["P":"GT531^PSIVORFA(DFN,ON)",$P(PSIVST,"^",4)["N":"GT531^PSIVORFA(DFN,O
N)",1:"GT55^PSIVORFB")
"RTN","PSIVPRO",40,0)
S X="",PS=PSIVX1 K ^TMP("PSIV",$J,PSIVST,PSIVON) D
"RTN","PSIVPRO",41,0)
.I ($P(PSIVST,"^")'="Cz") S
^TMP("PSIV",$J,PSIVST_"B",PSIVX1)=$S(PSIVST["P":$E(PSIVON,2,11),PSIVST["N":$E(PSIVON,2,11),1:PSIV
ON)_$S(PSIVST["P":"P",PSIVST["N":"P",1:"V")
"RTN","PSIVPRO",42,0)
.I ($P(PSIVST,"^")="Cz") S
^TMP("PSIV",$J,PSIVST_"B",PSIVX1)=$S($P(PSIVST,"^",4)["P":$E(PSIVON,2,11),$P(PSIVST,"^",4)["N":$E(P
SIVON,2,11),1:PSIVON)_$S($P(PSIVST,"^",4)["P":"P",$P(PSIVST,"^",4)["N":"P",1:"V")
"RTN","PSIVPRO",43,0)
.I PSIVST="RD"!($P(PSIVST,"^",4)="RD") D ENPL Q
"RTN","PSIVPRO",44,0)
I ($P(PSIVST,"^")'="Cz"),(PSIVST["D") N PSJO,PSIVX3 S PSIVX3=PSIVX1,PSJO=0 I $G(PSJCOM) D
"RTN","PSIVPRO",45,0)
.F S PSJO=$O(^PS(53.1,"ACX",PSJCOM,PSJO)) Q:'PSJO S ON=PSJO_"P" D
GT531^PSIVORFA(DFN,ON),ENPL S PSIVX1=""
"RTN","PSIVPRO",46,0)
I ($P(PSIVST,"^")'="Cz"),(PSIVST["D") S PSIVX1=PSIVX3 Q
"RTN","PSIVPRO",47,0)
;
"RTN","PSIVPRO",48,0)
ENPL ;
"RTN","PSIVPRO",49,0)
NEW MARX,DRUGNAME,X,XX
"RTN","PSIVPRO",50,0)
S PSJL=$J(PSIVX1,4) I ON["P",(P("OT")'="F"),P(4)'="H" D Q
"RTN","PSIVPRO",51,0)
. I $D(VALMEVL) D
"RTN","PSIVPRO",52,0)
.. N PSJFLAG
"RTN","PSIVPRO",53,0)
.. S PSJFLAG=$P($S(ON["V":$G(^PS(55,DFN,"IV",+ON,.2)),1:$G(^PS(53.1,+ON,.2))),U,7)
"RTN","PSIVPRO",54,0)
.. I PSJFLAG D CNTRL^VALM10(PSJLN,1,4,IORVON,IORVOFF,0)
"RTN","PSIVPRO",55,0)
. D DRGDISP^PSJLMUT1(DFN,ON,34,59,.DRUGNAME,0)
"RTN","PSIVPRO",56,0)
. NEW X F X=0:0 S X=$O(DRUGNAME(X)) Q:'X S:X>1 PSJL="" S
PSJL=$$SETSTR^VALM1(DRUGNAME(X),PSJL,$S(X=1:6,1:7),$S(X=1:34,1:65)) D:X=1 V D
SETTMP^PSJLMPRI
"RTN","PSIVPRO",57,0)
S X=$J(PSIVX1,4)_$S(P("PRY")="D":" d",1:" ")
"RTN","PSIVPRO",58,0)
I ON["V" S XX=$G(^PS(55,DFN,"IV",+ON,4)) D
"RTN","PSIVPRO",59,0)
. I +PSJSYSU=1,'+XX S X=X_"->"
"RTN","PSIVPRO",60,0)
. I +PSJSYSU=3,'+$P(XX,U,4) S X=X_"->"
"RTN","PSIVPRO",61,0)
S PSJL=X
"RTN","PSIVPRO",62,0)
I $D(VALMEVL) D
"RTN","PSIVPRO",63,0)
. N PSJFLAG
"RTN","PSIVPRO",64,0)
. S PSJFLAG=$P($S(ON["V":$G(^PS(55,DFN,"IV",+ON,.2)),1:$G(^PS(53.1,+ON,.2))),U,7)
"RTN","PSIVPRO",65,0)
. I PSJFLAG D CNTRL^VALM10(PSJLN,1,4,IORVON,IORVOFF,0)
"RTN","PSIVPRO",66,0)
NEW RNWPRTD S RNWPRTD=0 ;#373
"RTN","PSIVPRO",67,0)
D AD,SOL
"RTN","PSIVPRO",68,0)
I 'RNWPRTD D RENEWDT I PSJL["Renewed" D SETTMP^PSJLMPRI ;#373
"RTN","PSIVPRO",69,0)
Q
"RTN","PSIVPRO",70,0)
SOL ;
"RTN","PSIVPRO",71,0)
NEW NAME,PSJNOAD,L ;S PSJNOAD=0,L=34
"RTN","PSIVPRO",72,0)
S NAD=0 F S NAD=$O(DRG("SOL",NAD)) Q:'NAD D
"RTN","PSIVPRO",73,0)
. K NAME S L=34,PSJNOAD=0
"RTN","PSIVPRO",74,0)
. I '$D(DRG("AD",1)),NAD=1 S PSJNOAD=1,L=27
"RTN","PSIVPRO",75,0)
. S:NAD=1 PSJL=$$SETSTR^VALM1("in",PSJL,6,11)
"RTN","PSIVPRO",76,0)
. D NAME^PSIVUTL(DRG("SOL",NAD),L,.NAME,0)
"RTN","PSIVPRO",77,0)
. F X=0:0 S X=$O(NAME(X)) Q:'X S:(NAD>1!(X>1)) PSJL="" S PSJL=$$SETSTR^VALM1(NAME(X),PSJL,9,34)
D:X=1&PSJNOAD V D:(NAD>1!(X>1)) RENEWDT D SETTMP^PSJLMPRI ;#373 - Call to RENEWDT added
"RTN","PSIVPRO",78,0)
. S PSJL=""
"RTN","PSIVPRO",79,0)
Q
"RTN","PSIVPRO",80,0)
AD ;
"RTN","PSIVPRO",81,0)
NEW NAME
"RTN","PSIVPRO",82,0)
S NAD=0 F S NAD=$O(DRG("AD",NAD)) Q:'NAD D
"RTN","PSIVPRO",83,0)
. K NAME
"RTN","PSIVPRO",84,0)
. ;D NAME^PSIVUTL(DRG("AD",NAD),30,.NAME,1)
"RTN","PSIVPRO",85,0)
. D NAME^PSIVUTL(DRG("AD",NAD),27,.NAME,1)
"RTN","PSIVPRO",86,0)
. F X=0:0 S X=$O(NAME(X)) Q:'X S:(NAD>1!(X>1)) PSJL="" S PSJL=$$SETSTR^VALM1(NAME(X),PSJL,6,34)
D:(NAD=1&(X=1)) V D:(NAD>1!(X>1)) RENEWDT D SETTMP^PSJLMPRI ;#373 - Call to RENEWDT added
"RTN","PSIVPRO",87,0)
. S PSJL=""
"RTN","PSIVPRO",88,0)
Q
"RTN","PSIVPRO",89,0)
;
"RTN","PSIVPRO",90,0)
V S Y=$S(ON["V":$P($G(^PS(55,DFN,"IV",+ON,9)),U),1:"")
"RTN","PSIVPRO",91,0)
I +Y>0 X ^DD("DD") S Y=$P(Y,",")_" "_$P($P(Y,"@",2),":",1,2)
"RTN","PSIVPRO",92,0)
E S Y="** N/P **"
"RTN","PSIVPRO",93,0)
S PSJL=$$SETSTR^VALM1(Y,PSJL,33,12)
"RTN","PSIVPRO",94,0)
S PSJL=$$SETSTR^VALM1(" #"_$S(ON["V":+$P($G(^PS(55,DFN,"IV",+ON,9)),U,2),1:0),PSJL,46,3)
"RTN","PSIVPRO",95,0)
S:PSIVX1]"" PSIVX2=PSIVX2+1
"RTN","PSIVPRO",96,0)
D REST
"RTN","PSIVPRO",97,0)
Q
"RTN","PSIVPRO",98,0)
ACL ;
"RTN","PSIVPRO",99,0)
F X3=1:1:71 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" A c t i v e "
"RTN","PSIVPRO",100,0)
Q
"RTN","PSIVPRO",101,0)
NVL ;
"RTN","PSIVPRO",102,0)
F X3=1:1:71 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" N o n - V e r i f i e d "
"RTN","PSIVPRO",103,0)
Q
"RTN","PSIVPRO",104,0)
NVCL ;
"RTN","PSIVPRO",105,0)
F X3=1:1:71 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" N o n - V e r i f i e d C o m p l e x "
"RTN","PSIVPRO",106,0)
Q
"RTN","PSIVPRO",107,0)
POL ;
"RTN","PSIVPRO",108,0)
F X3=1:1:71 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" P e n d i n g "
"RTN","PSIVPRO",109,0)
Q
"RTN","PSIVPRO",110,0)
POCL ;
"RTN","PSIVPRO",111,0)
F X3=1:1:66 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" P e n d i n g C o m p l e x "
"RTN","PSIVPRO",112,0)
Q
"RTN","PSIVPRO",113,0)
NOL ;
"RTN","PSIVPRO",114,0)
F X3=1:1:66 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" N o t A c t i v e "
"RTN","PSIVPRO",115,0)
Q
"RTN","PSIVPRO",116,0)
CLIN(CLINIC) ; Print Clinic Name section header
"RTN","PSIVPRO",117,0)
N LEFTALIN S LEFTALIN=(80-$L(CLINIC))\2
"RTN","PSIVPRO",118,0)
F X3=1:1:71 S PSJL=PSJL_"-" S:(X3=(LEFTALIN)) PSJL=PSJL_CLINIC
"RTN","PSIVPRO",119,0)
Q
"RTN","PSIVPRO",120,0)
DPL ;Recently dc/expired header
"RTN","PSIVPRO",121,0)
S PSJDCEXP=$$RECDCEXP^PSJP()
"RTN","PSIVPRO",122,0)
F X3=1:1:71 S PSJL=PSJL_"-" S:X3=15 PSJL=PSJL_"Recently Discontinued/Expired (Last
"_+$G(PSJDCEXP)_" hours)"
"RTN","PSIVPRO",123,0)
Q
"RTN","PSIVPRO",124,0)
NOC ;
"RTN","PSIVPRO",125,0)
F X3=1:1:66 S PSJL=PSJL_"-" S:X3=34 PSJL=PSJL_" No current IV information "
"RTN","PSIVPRO",126,0)
;
"RTN","PSIVPRO",127,0)
S PSJL=""
"RTN","PSIVPRO",128,0)
Q
"RTN","PSIVPRO",129,0)
REST ;
"RTN","PSIVPRO",130,0)
S PSJL=$$SETSTR^VALM1(P(4),PSJL,52,1)
"RTN","PSIVPRO",131,0)
;S PSJL=$$SETSTR^VALM1($E($$ENDTC^PSGMI(P(2)),1,5),PSJL,55,5) ;#373
"RTN","PSIVPRO",132,0)
S PSJL=$$SETSTR^VALM1($E($$ENDTC2^PSGMI(P(2)),1,10),PSJL,55,10) ;#373
"RTN","PSIVPRO",133,0)
;S PSJL=$$SETSTR^VALM1($E($$ENDTC^PSGMI(P(3)),1,5),PSJL,62,5) ;#373
"RTN","PSIVPRO",134,0)
S PSJL=$$SETSTR^VALM1($E($$ENDTC2^PSGMI(P(3)),1,10),PSJL,66,10) ;#373
"RTN","PSIVPRO",135,0)
;S PSJL=$$SETSTR^VALM1($S(P(17)="R"&(ON'["V"):"R/I",$G(P(25))]"":P(25),1:P(17)),PSJL,69,2) ;#373
"RTN","PSIVPRO",136,0)
S PSJL=$$SETSTR^VALM1($S(P(17)="R"&(ON'["V"):"R/I",$G(P(25))]"":P(25),1:P(17)),PSJL,77,2) ;#373
"RTN","PSIVPRO",137,0)
;S PSJL=$$SETSTR^VALM1($S(ON["P":P("PRY"),1:""),PSJL,71,1) ;#373
"RTN","PSIVPRO",138,0)
S PSJL=$$SETSTR^VALM1($S(ON["P":P("PRY"),1:""),PSJL,79,1) ;#373
"RTN","PSIVPRO",139,0)
;N PSJLRN S PSJLRN=$$LASTREN^PSJLMPRI(DFN,ON55) I PSJLRN S
PSJLRN=$E($$ENDTC^PSGMI(PSJLRN),1,5) S PSJL=$$SETSTR^VALM1(PSJLRN,PSJL,74,5) ;#373
"RTN","PSIVPRO",140,0)
Q
"RTN","PSIVPRO",141,0)
RENEWDT ; 373 - Put renewal date on 2nd line instead of 1st.
"RTN","PSIVPRO",142,0)
Q:RNWPRTD
"RTN","PSIVPRO",143,0)
N PSJLRN S PSJLRN=$$LASTREN^PSJLMPRI(DFN,ON55)
"RTN","PSIVPRO",144,0)
I PSJLRN D
"RTN","PSIVPRO",145,0)
. S PSJLRN=$E($$ENDTC2^PSGMI(PSJLRN),1,10)
"RTN","PSIVPRO",146,0)
. S PSJL=$$SETSTR^VALM1("Renewed:",PSJL,55,8)
"RTN","PSIVPRO",147,0)
. S PSJL=$$SETSTR^VALM1(PSJLRN,PSJL,64,10),RNWPRTD=1
"RTN","PSIVPRO",148,0)
Q
"RTN","PSIVPRO",149,0)
XCHK ;
"RTN","PSIVPRO",150,0)
I $E(X)="?" W !!?2,"Select order",$E("s",PS'=1)," (1" W:PS>1 "-",PS W ")."
"RTN","PSIVPRO",151,0)
I $E(X)="?" W:$S($O(^TMP("PSIV",$J,PSIVST,ON)):1,1:$O(^TMP("PSIV",$J,PSIVST))]"") " Press RETURN
to view more orders, or enter '^' to abort",!,"the profile, or 'A' to view Allergies." D:$E(X,1,2)="??"
H2^PSGON K X Q
"RTN","PSIVPRO",152,0)
S PSGLMT=PS D ^PSGON Q
"RTN","PSIVPRO",153,0)
;
"RTN","PSIVPRO",154,0)
PSPD S Y=$S(PSIVST'="P":$P($G(^PS(55,DFN,"IV",+ON,9)),U),1:"")
"RTN","PSIVPRO",155,0)
X ^DD("DD") S:Y="" PSJL=$$SETSTR^VALM1("** N/P **",PSJL,36,12)
"RTN","PSIVPRO",156,0)
S:Y'=""
PSJL=$$SETSTR^VALM1($P(Y,","),PSJL,36,7),PSJL=$$SETSTR^VALM1($P($P(Y,"@",2),":",1,2),PSJL,43,45)
"RTN","PSIVPRO",157,0)
S PSJL=PSJL_" #"_$S(Y="":0,1:$P(^PS(55,DFN,"IV",+ON,9),U,2))
"RTN","PSIVPRO",158,0)
D REST
"RTN","PSIVPRO",159,0)
Q
"RTN","PSIVUTL")
0^12^B45543984^B42948271
"RTN","PSIVUTL",1,0)
PSIVUTL ;BIR/MLM - IV UTILITIES ;Jul 05, 2018@08:59
"RTN","PSIVUTL",2,0)
;;5.0;INPATIENT MEDICATIONS ;**69,58,81,85,110,133,181,263,275,279,373**;16 DEC 97;Build 3
"RTN","PSIVUTL",3,0)
;
"RTN","PSIVUTL",4,0)
; Reference to ^DD("DD" is supported by DBIA 10017.
"RTN","PSIVUTL",5,0)
; Reference to ^PS(50.7 is supported by DBIA 2180.
"RTN","PSIVUTL",6,0)
; Reference to ^PS(52.6 is supported by DBIA 1231.
"RTN","PSIVUTL",7,0)
; Reference to ^PS(55 is supported by DBIA 2191.
"RTN","PSIVUTL",8,0)
; Reference to ^PS(52.7 is supported by DBIA 2173.
"RTN","PSIVUTL",9,0)
; Reference to ^DIC is supported by DBIA 10006.
"RTN","PSIVUTL",10,0)
; Reference to ^PS(51.1 is supported by DBIA 2177.
"RTN","PSIVUTL",11,0)
;
"RTN","PSIVUTL",12,0)
DRGSC(Y,PSJSCT) ; Called to set DIC("S") when selecting Orderable Items.
"RTN","PSIVUTL",13,0)
N OK,ND,NDU,NDI S OK=0
"RTN","PSIVUTL",14,0)
S ND=$G(^PS(50.7,+Y,0))
"RTN","PSIVUTL",15,0)
;I $P(ND,U,3) S OK=$S('$P(ND,U,4):1,$P(ND,U,4)>DT:1,1:0)
"RTN","PSIVUTL",16,0)
S OK=$S('$P(ND,U,4):1,$P(ND,U,4)>DT:1,1:0)
"RTN","PSIVUTL",17,0)
Q OK
"RTN","PSIVUTL",18,0)
;
"RTN","PSIVUTL",19,0)
IVDRGSC(Y) ; Set DIC("S") for IV additive/solution selection.
"RTN","PSIVUTL",20,0)
; Naked reference below refers to full reference in Y, which is either ^PS(52.6, or ^PS(52.7
"RTN","PSIVUTL",21,0)
N Y S Y="S X(1)=$G(^(0)),X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0),$D(^PSDRUG(+$P(X(1),U,2),0)) S
X(2)=$G(^(""I"")) I $S('+$P(X(1),U,11):0,'X(2):1,X(2)>DT:1,1:0)"
"RTN","PSIVUTL",22,0)
Q Y
"RTN","PSIVUTL",23,0)
;
"RTN","PSIVUTL",24,0)
ENU(Y) ;Get IV additive strength.
"RTN","PSIVUTL",25,0)
N X S X=$P(^PS(52.6,+Y,0),U,3),Y=$$CODES^PSIVUTL(X,52.6,2)
"RTN","PSIVUTL",26,0)
Q Y
"RTN","PSIVUTL",27,0)
;
"RTN","PSIVUTL",28,0)
CODES(PSJCD,PSJF,PSJFLD) ; Get name from code.
"RTN","PSIVUTL",29,0)
; PSJF = one of following files: ^PS(55, ^PS(53.1, ^PS(52.6
"RTN","PSIVUTL",30,0)
D FIELD^DID(PSJF,PSJFLD,"","POINTER","PSJDD")
"RTN","PSIVUTL",31,0)
S Y=$G(PSJDD("POINTER")) K PSJDD
"RTN","PSIVUTL",32,0)
S Y=$P($P(";"_Y,";"_PSJCD_":",2),";")
"RTN","PSIVUTL",33,0)
Q Y
"RTN","PSIVUTL",34,0)
;
"RTN","PSIVUTL",35,0)
CODES1(PSJCD,PSJF,PSJFLD) ;Check to see if code is valid.
"RTN","PSIVUTL",36,0)
; PSJF = one of following files: ^PS(55, ^PS(53.1, ^PS(52.6
"RTN","PSIVUTL",37,0)
D FIELD^DID(PSJF,PSJFLD,"","POINTER","PSJDD")
"RTN","PSIVUTL",38,0)
I PSJDD("POINTER")'[PSJCD_":" K PSJDD Q 0
"RTN","PSIVUTL",39,0)
K PSJDD Q 1
"RTN","PSIVUTL",40,0)
;
"RTN","PSIVUTL",41,0)
CODES2(PSJF,PSJFLD) ;Get field name
"RTN","PSIVUTL",42,0)
; PSJF = one of following files: ^PS(55, ^PS(53.1, ^PS(52.6
"RTN","PSIVUTL",43,0)
D FIELD^DID(PSJF,PSJFLD,"","LABEL","PSJDD")
"RTN","PSIVUTL",44,0)
Q PSJDD("LABEL")
"RTN","PSIVUTL",45,0)
;
"RTN","PSIVUTL",46,0)
GTPCI(Y) ; Set up "work" area for provider comments.
"RTN","PSIVUTL",47,0)
N DIC,DINUM,DLAYGO,X S DIC="^PS(53.45,",DIC(0)="LNZ",DLAYGO=53.45,(DINUM,X)=+DUZ D ^DIC
"RTN","PSIVUTL",48,0)
Q Y
"RTN","PSIVUTL",49,0)
;
"RTN","PSIVUTL",50,0)
WDTE(Y) ; Format and print date.
"RTN","PSIVUTL",51,0)
I 'Y S Y="******"
"RTN","PSIVUTL",52,0)
E X ^DD("DD") S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)
"RTN","PSIVUTL",53,0)
Q Y
"RTN","PSIVUTL",54,0)
GTOT(Y) ; Get order type & protocol
"RTN","PSIVUTL",55,0)
I ($G(ON55)["V"),$G(DFN) D GTNUMLBL(DFN,ON55)
"RTN","PSIVUTL",56,0)
N DRGI,DRGT
"RTN","PSIVUTL",57,0)
S P("OT")=$S(Y="A":"F",Y="H":"H",1:"I")
"RTN","PSIVUTL",58,0)
I P("OT")="F" F DRGT="AD","SOL" F DRGI=0:0 S DRGI=$O(DRG(DRGT,DRGI)) Q:'DRGI I
'$P(DRG(DRGT,DRGI),U,5) S P("OT")="I" Q
"RTN","PSIVUTL",59,0)
Q
"RTN","PSIVUTL",60,0)
;
"RTN","PSIVUTL",61,0)
PIV(ON) ; Display IV orders.
"RTN","PSIVUTL",62,0)
N DRG,ON55,P,PSJORIFN,TYP,X,Y S TYP="?" I ON["V" D
"RTN","PSIVUTL",63,0)
.S Y=$G(^PS(55,DFN,"IV",+ON,0)) F X=2,3,4,5,8,9,17,23,25 S P(X)=$P(Y,U,X)
"RTN","PSIVUTL",64,0)
.S TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I TYP'="O" S TYP="C"
"RTN","PSIVUTL",65,0)
.S ON55=ON,P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I") D GTDRG^PSIVORFB,GTOT^PSIVUTL(P(4))
"RTN","PSIVUTL",66,0)
.W $S($P($G(^PS(55,DFN,"IV",+ON,.2)),U,4)="D":" d",1:" ")
"RTN","PSIVUTL",67,0)
.S X=$G(^PS(55,DFN,"IV",+ON,4)) I +PSJSYSU,'+$P(X,U,$S(+PSJSYSU=3:4,1:++PSJSYSU)) W "->"
"RTN","PSIVUTL",68,0)
.S ND14=$G(^PS(55,DFN,"IV",+ON,14,0)),ND14=$P(ND14,U,3) S:ND14 ND14=+$G(^(ND14,0)) ;#373 -
Retrieve Renewal Dt, if any
"RTN","PSIVUTL",69,0)
I ON=+ON N O S O="" F S O=$O(^PS(53.1,"ACX",ON,O)) Q:O="" D
"RTN","PSIVUTL",70,0)
. S
(P(2),P(3))="",P(17)=$P($G(^PS(53.1,+O,0)),U,9),Y=$G(^(8)),P(4)=$P(Y,U),P(8)=$P(Y,U,5),P(9)=$P($G(^(2))
,U) D GTDRG^PSIVORFA,GTOT^PSIVUTL(P(4)) D PIV(O_"P") W !
"RTN","PSIVUTL",71,0)
I ON["P" D GETP(ON) D GTDRG^PSIVORFA,GTOT^PSIVUTL(P(4)) I $E(P("OT"))="I" D Q
"RTN","PSIVUTL",72,0)
. I $G(PSJCLOR) N ND2 S ND2=$G(^PS(53.1,+ON,2)) S P(2)=$P(ND2,"^",2),P(3)=$P(ND2,"^",4)
"RTN","PSIVUTL",73,0)
. NEW MARX,PSIVX
"RTN","PSIVUTL",74,0)
. ;D DRGDISP^PSJLMUT1(PSGP,+ON_"P",40,54,.MARX,0) ;#373
"RTN","PSIVUTL",75,0)
. D DRGDISP^PSJLMUT1(PSGP,+ON_"P",34,28,.MARX,0) ;#373
"RTN","PSIVUTL",76,0)
. F PSIVX=0:0 S PSIVX=$O(MARX(PSIVX)) Q:'PSIVX W @($S(PSIVX=1:"?9",1:"!?11")),MARX(PSIVX)
D:PSIVX=1 PIV1
"RTN","PSIVUTL",77,0)
NEW PIV2PRT,RNDTPRT S (PIV2PRT,RNDTPRT)=0 ;#373 - Keep track if PIV2 API run, Renewal Date
printed
"RTN","PSIVUTL",78,0)
NEW DRGX S DRGX=0 F S DRGX=$O(DRG("AD",DRGX)) Q:'DRGX D PIVAD
"RTN","PSIVUTL",79,0)
SOL ;
"RTN","PSIVUTL",80,0)
NEW NAME
"RTN","PSIVUTL",81,0)
S DRGX=0 F S DRGX=$O(DRG("SOL",DRGX)) Q:'DRGX D
"RTN","PSIVUTL",82,0)
. D NAME(DRG("SOL",DRGX),34,.NAME,0) ; #373 Changed length to 34 from 39
"RTN","PSIVUTL",83,0)
. W:($D(DRG("AD",1))!(DRGX>1)) ! W:DRGX=1 ?9,"in "
"RTN","PSIVUTL",84,0)
. ;F X=0:0 S X=$O(NAME(X)) Q:'X W ?12 W NAME(X) I X=1,DRGX=1,'$D(DRG("AD",1)) D PIV1 ;#373
"RTN","PSIVUTL",85,0)
. F X=0:0 S X=$O(NAME(X)) Q:'X W:X'=1 ! W ?12 W NAME(X) D:PIV2PRT RENEWDT D ;#373
"RTN","PSIVUTL",86,0)
.. I X=1,DRGX=1,'$D(DRG("AD",1)) D PIV2 ;#373
"RTN","PSIVUTL",87,0)
I 'RNDTPRT,$G(ND14)]"" W ! D RENEWDT
"RTN","PSIVUTL",88,0)
Q
"RTN","PSIVUTL",89,0)
PIVAD ; Print IV Additives.
"RTN","PSIVUTL",90,0)
NEW NAME,PSGX
"RTN","PSIVUTL",91,0)
D NAME(DRG("AD",DRGX),34,.NAME,1) ; #373 Changed length to 34 from 39
"RTN","PSIVUTL",92,0)
;F PSGX=0:0 S PSGX=$O(NAME(PSGX)) Q:'PSGX W:(DRGX'=1!(PSGX'=1)) ! W ?9,NAME(PSGX) I
PSGX=1,DRGX=1 D PIV1 ;#373
"RTN","PSIVUTL",93,0)
F PSGX=0:0 S PSGX=$O(NAME(PSGX)) Q:'PSGX W:(DRGX'=1!(PSGX'=1)) ! W ?9,NAME(PSGX)
D:(DRGX=2!(PSGX=2)) RENEWDT I PSGX=1,DRGX=1 D PIV2 ;#373
"RTN","PSIVUTL",94,0)
Q
"RTN","PSIVUTL",95,0)
;
"RTN","PSIVUTL",96,0)
PIV1 ; Print Sched type, start/stop dates, and status.
"RTN","PSIVUTL",97,0)
F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5))
"RTN","PSIVUTL",98,0)
; #373 fields in PIV1 should line up with new columns in PIV2
"RTN","PSIVUTL",99,0)
;I '$D(PSJEXTP) W ?50,TYP,?53,P(2),?60,P(3),?67,$S($G(P(25))]"":P(25),1:P(17)) Q
"RTN","PSIVUTL",100,0)
;W ?50,TYP,?53,P(2),?63,P(3),?73,$S($G(P(25))]"":P(25),1:P(17))
"RTN","PSIVUTL",101,0)
I '$D(PSJEXTP) W ?46,TYP,?49,P(2),?60,P(3),?71,$S($G(P(25))]"":P(25),1:P(17)) Q
"RTN","PSIVUTL",102,0)
W ?46,TYP,?49,P(2),?60,P(3),?71,$S($G(P(25))]"":P(25),1:P(17))
"RTN","PSIVUTL",103,0)
Q
"RTN","PSIVUTL",104,0)
PIV2 ; Print Sched type, start/stop dates with four digit year, and status. ;#373
"RTN","PSIVUTL",105,0)
F X=2,3 S P(X)=$E($$ENDTC2^PSGMI(P(X)),1,$S($D(PSJEXTP):10,1:10))
"RTN","PSIVUTL",106,0)
I '$D(PSJEXTP) W ?46,TYP,?49,P(2),?60,P(3),?71,$S($G(P(25))]"":P(25),1:P(17)) S PIV2PRT=1 Q
"RTN","PSIVUTL",107,0)
W ?46,TYP,?49,P(2),?60,P(3),?71,$S($G(P(25))]"":P(25),1:P(17)) S PIV2PRT=1
"RTN","PSIVUTL",108,0)
Q
"RTN","PSIVUTL",109,0)
RENEWDT ; 373 - Put renewal date on 2nd line instead of 1st.
"RTN","PSIVUTL",110,0)
Q:$G(ND14)="" Q:RNDTPRT S ND14=$$ENDTC2^PSGMI(ND14)
"RTN","PSIVUTL",111,0)
W ?49,"Renewed: ",$P(ND14," ") S RNDTPRT=1
"RTN","PSIVUTL",112,0)
Q
"RTN","PSIVUTL",113,0)
59 ; Validate the Infusion rate entered using IV Quick order code.
"RTN","PSIVUTL",114,0)
N I F I=2,3,5,7,8,9,11,15,23 S P(I)=""
"RTN","PSIVUTL",115,0)
S P(4)="A",P(8)=$P($G(^PS(57.1,PSJQO,1)),U,5)
"RTN","PSIVUTL",116,0)
I $G(^PS(57.1,PSJQO,4,1,0)) S DRG("SOL",1)=^(0),DRG("SOL",0)=1
"RTN","PSIVUTL",117,0)
I X["?" S F1=53.1,F2=59 D ENHLP^PSIVORC1 G 59
"RTN","PSIVUTL",118,0)
I X]"" D ENI^PSIVSP S:$D(X) P(8)=X
"RTN","PSIVUTL",119,0)
K F1,F2
"RTN","PSIVUTL",120,0)
Q
"RTN","PSIVUTL",121,0)
WRTDRG(X,L) ; Format and print drug name, strength and bottle no.
"RTN","PSIVUTL",122,0)
N Y S Y=" "_$P(X,U,3) S:$P(X,U,4) Y=Y_" ("_$P(X,U,4)_")"
"RTN","PSIVUTL",123,0)
Q $E($P(X,U,2),1,(L-$L(Y)))_Y
"RTN","PSIVUTL",124,0)
;
"RTN","PSIVUTL",125,0)
NAME(X,L,MARX,AD) ; Format Additive display.
"RTN","PSIVUTL",126,0)
;INPUT : X=DRG("AD",DRG) L=Display length AD=for Additive(1/0)
"RTN","PSIVUTL",127,0)
;OUTPUT: AD(X) if X=2 that means there is a second line to display
"RTN","PSIVUTL",128,0)
N Y K MARX S Y=$P(X,U,3) S:(AD&($P(X,U,4)]"")) Y=Y_" ("_$P(X,U,4)_")"
"RTN","PSIVUTL",129,0)
;* S:'AD Y=Y_" "_$S(P(4)="P"!($G(P(23))="P")!$G(P(5)):P(9),1:$P(P(8),"@"))
"RTN","PSIVUTL",130,0)
I 'AD!('$O(DRG("SOL",0))) D
"RTN","PSIVUTL",131,0)
.I $G(PSJL)[" in" S Y=Y_" "_$S(P(4)="P"!($G(P(23))="P")!$G(P(5)):P(9),1:$P(P(8),"@")) Q
"RTN","PSIVUTL",132,0)
.I $G(DRGX)]"",DRGX'>1 S Y=Y_" "_$S(P(4)="P"!($G(P(23))="P")!$G(P(5)):P(9),1:$P(P(8),"@")) Q
"RTN","PSIVUTL",133,0)
;I ($L($P(X,U,2))+$L(Y)+1)>L S NAME(1)=$P(X,U,2),NAME(2)=" "_Y Q
"RTN","PSIVUTL",134,0)
I ($L($P(X,U,2))+$L(Y)+1)>L D TXT^PSGMUTL($P(X,U,2)_" "_Y,L) S:AD MARX(2)=" "_MARX(2) Q
"RTN","PSIVUTL",135,0)
S MARX(1)=$P(X,U,2)_" "_Y
"RTN","PSIVUTL",136,0)
Q
"RTN","PSIVUTL",137,0)
;
"RTN","PSIVUTL",138,0)
INTERVAL(IVAR) ;
"RTN","PSIVUTL",139,0)
N P,X,PSGOES M P=IVAR S X=$G(P(9)),PSGOES=1
"RTN","PSIVUTL",140,0)
D EN^PSIVSP S IVAR(15)=$S($G(P(15)):P(15),1:1440)
"RTN","PSIVUTL",141,0)
Q IVAR(15)
"RTN","PSIVUTL",142,0)
;
"RTN","PSIVUTL",143,0)
DOW(SCHED) ;
"RTN","PSIVUTL",144,0)
Q:SCHED="" 0
"RTN","PSIVUTL",145,0)
N P9,PSIVX,X S PSIVX=0 S P9=SCHED
"RTN","PSIVUTL",146,0)
; Use schedule validator
"RTN","PSIVUTL",147,0)
S X=SCHED D DW^PSGS0 I $G(X)="" Q 0
"RTN","PSIVUTL",148,0)
I +$O(^PS(51.1,"APPSJ",SCHED,0)) S PSIVX=1 S P9=$P(SCHED,"@") F X=1:1:$L(P9,"-") D Q:'$G(PSIVX)
"RTN","PSIVUTL",149,0)
. I '("MON,TUE,WED,THU,FRI,SAT,SUN"[$P(P9,"-",X)) S PSIVX=0 Q
"RTN","PSIVUTL",150,0)
Q:PSIVX +PSIVX
"RTN","PSIVUTL",151,0)
I '$D(^PS(51.1,"APPSJ",SCHED)) S PSIVX=1,P9=$P(SCHED,"@") F X=1:1:$L(P9,"-") D Q:'$G(PSIVX)
"RTN","PSIVUTL",152,0)
. I '(",MO,TU,WE,TH,FR,SA,SU,"[(","_$P(P9,"-",X)_",")) S PSIVX=0 Q
"RTN","PSIVUTL",153,0)
Q +PSIVX
"RTN","PSIVUTL",154,0)
;
"RTN","PSIVUTL",155,0)
GETP(ON) ; Populate P array with data from order ON
"RTN","PSIVUTL",156,0)
I ON["P" S
(P(2),P(3))="",P(17)=$P($G(^PS(53.1,+ON,0)),U,9),Y=$G(^(8)),P(4)=$P(Y,U),P(8)=$P(Y,U,5),P(9)=$P($G(^(
2)),U) D
"RTN","PSIVUTL",157,0)
.I $G(PSJCLOR) N ND2 S ND2=$G(^PS(53.1,+ON,2)) S P(2)=$P(ND2,"^",2),P(3)=$P(ND2,"^",4) S
TYP=$P(^PS(53.1,+ON,0),"^",7)
"RTN","PSIVUTL",158,0)
Q
"RTN","PSIVUTL",159,0)
GTNUMLBL(DFN,ON) ; Get Number of Labels Per Day
"RTN","PSIVUTL",160,0)
Q:'$G(DFN) Q:'$G(ON)
"RTN","PSIVUTL",161,0)
S:'$D(P("NUMLBL"))
P("NUMLBL")=$S(($G(^PS(55,DFN,"IV",+ON55,11))?1.N):+$G(^(11)),($G(P(8))]""):$P($G(P(8)),"@",2),1:""
)
"RTN","PSIVUTL",162,0)
S:(P("NUMLBL")'?1.N) P("NUMLBL")=""
"RTN","PSIVUTL",163,0)
N PSJABBIN S PSJABBIN=$P($G(P(8)),"@") D
"RTN","PSIVUTL",164,0)
.Q:(PSJABBIN?1"INFUSE OVER "1.N1" MINUTES")
"RTN","PSIVUTL",165,0)
.D EXPINF^PSIVEDT1(.PSJABBIN,1) S P(8)=PSJABBIN_$S($G(P("NUMLBL"))?1.N:"@"_P("NUMLBL"),1:"")
"RTN","PSIVUTL",166,0)
Q
"RTN","PSJLIUTL")
0^13^B58538062^B58537636
"RTN","PSJLIUTL",1,0)
PSJLIUTL ;BIR/MV - IV LM utilities modules ;Jul 02, 2018@09:45
"RTN","PSJLIUTL",2,0)
;;5.0;INPATIENT MEDICATIONS ;**39,50,58,81,85,110,180,263,267,373**;16 DEC 97;Build 3
"RTN","PSJLIUTL",3,0)
;
"RTN","PSJLIUTL",4,0)
; Reference to ^ORD(101 is supported by DBIA #872.
"RTN","PSJLIUTL",5,0)
; Reference to ^PS(55 is supported by DBIA #2191.
"RTN","PSJLIUTL",6,0)
; Reference to ES^ORX8 is supported by DBIA #3632.
"RTN","PSJLIUTL",7,0)
; Reference to ^PS(52.7 is supported by DBIA 2173.
"RTN","PSJLIUTL",8,0)
; Reference to ^PS(52.6 is supported by DBIA 1231.
"RTN","PSJLIUTL",9,0)
;
"RTN","PSJLIUTL",10,0)
; NFI changes for FR#2@wrtdrg(drgt)
"RTN","PSJLIUTL",11,0)
FLDNO(X,COL) ; Display the number next to the field name.
"RTN","PSJLIUTL",12,0)
;
"RTN","PSJLIUTL",13,0)
; X=Text; COL=Column to start from
"RTN","PSJLIUTL",14,0)
;
"RTN","PSJLIUTL",15,0)
S:'$D(PSJSTAR) PSJSTAR=""
"RTN","PSJLIUTL",16,0)
NEW PSJOLDOT S PSJOLDOT=P("OT") D GTOT^PSIVUTL(P(4))
"RTN","PSJLIUTL",17,0)
S X=$S((X="(3)"&(P("OT")="I")):" ",PSJSTAR[X:"*",1:" ")_X
"RTN","PSJLIUTL",18,0)
S PSJL=$$SETSTR^VALM1($S(($G(PSJHIS)&(ON'=PSJORD)):"",1:X),PSJL,COL,5)
"RTN","PSJLIUTL",19,0)
Q
"RTN","PSJLIUTL",20,0)
;
"RTN","PSJLIUTL",21,0)
LONG(Y,COL,LEN) ; Display long fields.
"RTN","PSJLIUTL",22,0)
;
"RTN","PSJLIUTL",23,0)
; Y=Text string; COL=Start prt at this col; LEN=Total lenght per line.
"RTN","PSJLIUTL",24,0)
;
"RTN","PSJLIUTL",25,0)
N STRLEN,STR S STR="",STRLEN=1
"RTN","PSJLIUTL",26,0)
; If string has no blank space.
"RTN","PSJLIUTL",27,0)
I $L(Y," ")=1,$L(Y)>LEN D Q
"RTN","PSJLIUTL",28,0)
. S LINE=$L(Y)\LEN+$S($L(Y)#LEN:1,1:0)
"RTN","PSJLIUTL",29,0)
. F X=1:1:LINE-1 D
"RTN","PSJLIUTL",30,0)
. . S PSJL=$$SETSTR^VALM1($E(Y,STRLEN,LEN*X),PSJL,COL,LEN)
"RTN","PSJLIUTL",31,0)
. . D SETTMP^PSJLMPRU("PSJI",PSJL) S PSJL="",STRLEN=LEN*X+1
"RTN","PSJLIUTL",32,0)
. S PSJL=$$SETSTR^VALM1($E(Y,STRLEN,LEN*LINE),PSJL,COL,LEN)
"RTN","PSJLIUTL",33,0)
;
"RTN","PSJLIUTL",34,0)
F X=1:1:$L(Y," ") D
"RTN","PSJLIUTL",35,0)
. I $L(STR)+$L($P(Y," ",X))>LEN D
"RTN","PSJLIUTL",36,0)
. . S PSJL=$$SETSTR^VALM1(STR,PSJL,COL,LEN)
"RTN","PSJLIUTL",37,0)
. . D SETTMP^PSJLMPRU("PSJI",PSJL) S (STR,PSJL)=""
"RTN","PSJLIUTL",38,0)
. S STR=STR_$P(Y," ",X)_" "
"RTN","PSJLIUTL",39,0)
S PSJL=$$SETSTR^VALM1(STR,PSJL,COL,LEN)
"RTN","PSJLIUTL",40,0)
Q
"RTN","PSJLIUTL",41,0)
;
"RTN","PSJLIUTL",42,0)
WRTDRG(DRGT) ; Print AD/SOL drugs for "backdoor" view.
"RTN","PSJLIUTL",43,0)
NEW DRGX,PSJIVIEN,PSJX,PSJX1
"RTN","PSJLIUTL",44,0)
F DRGX=0:0 S DRGX=$O(DRG(DRGT,DRGX)) Q:'DRGX D
"RTN","PSJLIUTL",45,0)
. S (PSJIVIEN,X)=$G(DRG(DRGT,DRGX)) I DRGT="SOL",$P($G(^PS(52.7,+X,0)),U,4)]"" S
$P(X,U,2)=$P(X,U,2)_" "_$P(^(0),U,4)
"RTN","PSJLIUTL",46,0)
. S PSJX1=$S($P(X,U,4)]"":"("_$P(X,U,4)_")",1:$P(X,U,4))
"RTN","PSJLIUTL",47,0)
. S PSJL="",PSJX=$S($P(X,U,2)]"":$P(X,U,2)_" "_$P(X,U,3)_" "_PSJX1,1:"*** Undefined ***")
"RTN","PSJLIUTL",48,0)
. ;S PSJL="",PSJX=$S($P(X,U,2)]"":$P(X,U,2)_" "_$P(X,U,3)_" "_$P(X,U,4),1:"*** Undefined ***")
"RTN","PSJLIUTL",49,0)
. NEW PSJNF D NFIV^PSJDIN($S(DRGT="AD":52.6,1:52.7),+PSJIVIEN,.PSJNF)
"RTN","PSJLIUTL",50,0)
. S PSJX=PSJX_PSJNF("NF")
"RTN","PSJLIUTL",51,0)
. S PSJL=$$SETSTR^VALM1(PSJX,PSJL,8,72)
"RTN","PSJLIUTL",52,0)
. D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIUTL",53,0)
. ;PSJLMX is newed in AD^PSJLIVMD & AD^PSJLIVFD. This var count # of ad/sol so we knows
"RTN","PSJLIUTL",54,0)
. ;which line to blink the Requested start/stop dates.
"RTN","PSJLIUTL",55,0)
. S PSJLMX=$G(PSJLMX)+1
"RTN","PSJLIUTL",56,0)
Q
"RTN","PSJLIUTL",57,0)
;
"RTN","PSJLIUTL",58,0)
WTPC ; Write provider comments.
"RTN","PSJLIUTL",59,0)
I $G(PSJORD),PSJORD["P" F PSIVX=0:0 S PSIVX=$O(^PS(53.1,+PSJORD,12,PSIVX))
Q:'PSIVX!$D(DUOUT)!$D(DTOUT) S Y=$G(^PS(53.1,+PSJORD,12,PSIVX,0)) D LONG(Y,22,58) D
SETTMP^PSJLMPRU("PSJI",PSJL) S PSJL=""
"RTN","PSJLIUTL",60,0)
Q:$G(PSIVCHG)=1
"RTN","PSJLIUTL",61,0)
I $G(PSJORD),PSJORD'["P" F PSIVX=0:0 S PSIVX=$O(^PS(55,DFN,"IV",+PSJORD,5,PSIVX))
Q:'PSIVX!$D(DUOUT)!$D(DTOUT) S Y=$G(^PS(55,DFN,"IV",+PSJORD,5,PSIVX,0)) D LONG(Y,22,58) D
SETTMP^PSJLMPRU("PSJI",PSJL) S PSJL=""
"RTN","PSJLIUTL",62,0)
Q
"RTN","PSJLIUTL",63,0)
;
"RTN","PSJLIUTL",64,0)
TYPE() ; IV Type
"RTN","PSJLIUTL",65,0)
S X=$$CODES^PSIVUTL(P(4),53.1,53) S X=$S($E(X)="C":"CHEMO",1:X)_$S(P(23)'="":"
("_P(23)_")",1:"")_$S(P(5)=1:" (I)",P(5)=0:"(C)",1:"")
"RTN","PSJLIUTL",66,0)
Q X
"RTN","PSJLIUTL",67,0)
;
"RTN","PSJLIUTL",68,0)
STARTDT() ; Start Date
"RTN","PSJLIUTL",69,0)
S X="" I $D(PSIVNUM) S:P("DTYP") X=$S(P(17)="P"!(PSIVAC="PN"):"
",1:"*")_$S(P("DTYP")=1:"(12)",$E(P("OT"))="I":"(10)",1:"(8)")
"RTN","PSJLIUTL",70,0)
Q $$ENDTC^PSGMI(P(2))
"RTN","PSJLIUTL",71,0)
;
"RTN","PSJLIUTL",72,0)
STARTDT2() ; Start Date with 4 digit year #373
"RTN","PSJLIUTL",73,0)
S X="" I $D(PSIVNUM) S:P("DTYP") X=$S(P(17)="P"!(PSIVAC="PN"):"
",1:"*")_$S(P("DTYP")=1:"(12)",$E(P("OT"))="I":"(10)",1:"(8)")
"RTN","PSJLIUTL",74,0)
Q $$ENDTC2^PSGMI(P(2))
"RTN","PSJLIUTL",75,0)
;
"RTN","PSJLIUTL",76,0)
STOPDT() ; Stop Date
"RTN","PSJLIUTL",77,0)
S X="" I $D(PSIVNUM) S:P("DTYP") X=$S(P(17)="P"!(PSIVAC="PN"):"
",1:"*")_$S(P("DTYP")=1:"(13)",$E(P("OT"))="I":"(11)",1:"(9)")
"RTN","PSJLIUTL",78,0)
Q $$ENDTC^PSGMI(P(3))
"RTN","PSJLIUTL",79,0)
;
"RTN","PSJLIUTL",80,0)
STOPDT2() ; Stop Date with 4 digit year #373
"RTN","PSJLIUTL",81,0)
S X="" I $D(PSIVNUM) S:P("DTYP") X=$S(P(17)="P"!(PSIVAC="PN"):"
",1:"*")_$S(P("DTYP")=1:"(13)",$E(P("OT"))="I":"(11)",1:"(9)")
"RTN","PSJLIUTL",82,0)
Q $$ENDTC2^PSGMI(P(3))
"RTN","PSJLIUTL",83,0)
;
"RTN","PSJLIUTL",84,0)
PROVIDER() ; Provider
"RTN","PSJLIUTL",85,0)
S X="" I $D(PSIVNUM),P("DTYP") S X=$S(PSIVAC="PN":"
",1:"*")_$S(P("DTYP")=1:"(14)",$E(P("OT"))="I":"(12)",1:"(10)") ;I P(17)="P",(+P("CLRK")=+P(6)) S X=""
"RTN","PSJLIUTL",86,0)
I $G(P(21))]"",$L($T(ES^ORX8)) N ESIG,ESIG1 S ESIG=P("NAT"),ESIG1=$$ES^ORX8(+P(21)_";1") S:ESIG1=1
ESIG="ES"
"RTN","PSJLIUTL",87,0)
S X=$S($P(P(6),U,2)]"":$E($P(P(6),U,2),1,23),1:"*** Undefined") S:$G(ESIG)]"" X=X_"
["_$$LOW^XLFSTR(ESIG)_"]"
"RTN","PSJLIUTL",88,0)
Q X
"RTN","PSJLIUTL",89,0)
WDTE(Y) ; Format and print date.
"RTN","PSJLIUTL",90,0)
I 'Y S Y=""
"RTN","PSJLIUTL",91,0)
E X ^DD("DD") S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)
"RTN","PSJLIUTL",92,0)
Q Y
"RTN","PSJLIUTL",93,0)
;
"RTN","PSJLIUTL",94,0)
ACTIONS() ;
"RTN","PSJLIUTL",95,0)
N DIC,X,Y
"RTN","PSJLIUTL",96,0)
S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
"RTN","PSJLIUTL",97,0)
I Y="PSJI LM DISCONTINUE" Q $S(PSGACT["D":1,1:0)
"RTN","PSJLIUTL",98,0)
I Y="PSJI LM EDIT" Q $S(PSGACT["E":1,1:0)
"RTN","PSJLIUTL",99,0)
I Y="PSJI PC RENEWAL" Q $S(PSGACT["R":1,1:0)
"RTN","PSJLIUTL",100,0)
I Y="PSJI PC HOLD" Q $S(PSGACT["H":1,1:0)
"RTN","PSJLIUTL",101,0)
I Y="PSJI PC ONCALL" Q $S(PSGACT["O":1,1:0)
"RTN","PSJLIUTL",102,0)
I Y="PSJI LM VERIFY" Q $S(PSGACT["V":1,1:0)
"RTN","PSJLIUTL",103,0)
I Y="PSJ LM FLAG" Q $S(PSGACT["G":1,1:0)
"RTN","PSJLIUTL",104,0)
;PSJ*5*180
"RTN","PSJLIUTL",105,0)
I $G(PSJBADD)=1,PSGACT["F" S PSGACT=$TR(PSGACT,"F")
"RTN","PSJLIUTL",106,0)
I Y="PSJI LM FINISH" Q $S(PSGACT["F":1,1:0)
"RTN","PSJLIUTL",107,0)
I Y="PSJ LM IV PENDING" Q $S(PSGACT["F":1,1:0)
"RTN","PSJLIUTL",108,0)
Q 1
"RTN","PSJLIUTL",109,0)
;
"RTN","PSJLIUTL",110,0)
ACT() ;
"RTN","PSJLIUTL",111,0)
NEW Y
"RTN","PSJLIUTL",112,0)
S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
"RTN","PSJLIUTL",113,0)
I $G(PSJHIDFG),(Y="PSJ LM NEW ORDER") Q 0
"RTN","PSJLIUTL",114,0)
I Y="PSJ LM NEW ORDER FROM PROFILE" Q $S($G(PSIVBR)="D ^PSIVOPT":1,1:0)
"RTN","PSJLIUTL",115,0)
Q 1
"RTN","PSJLIUTL",116,0)
;
"RTN","PSJLIUTL",117,0)
REQDT(ORDER) ;
"RTN","PSJLIUTL",118,0)
Q:$G(ORDER)'["P" N ND0,PARENT I '$D(PSGRDTX(+ORDER)) K PSGRDTX
"RTN","PSJLIUTL",119,0)
S
PSGRDTX=$G(^PS(53.1,+ORDER,2.5)),ND0=$G(^PS(53.1,+ORDER,0)),PARENT=$P($G(^PS(53.1,+ORDER,.2
)),"^",8),(PSGRSD,PSGRSDN,PSGRFD,PSGRFDN)=""
"RTN","PSJLIUTL",120,0)
Q:'$G(PSGRDTX) I '$P(PSGRDTX,"^",3)&'PARENT Q ; Complex orders (duration OR parent) only?
"RTN","PSJLIUTL",121,0)
I $P(ND0,U,9)'["P"!($P(ND0,U,24)="R") K PSGRDTX,PSGRFD,PSGRFDN Q
"RTN","PSJLIUTL",122,0)
S $P(PSGRDTX,U,4)=ORDER
"RTN","PSJLIUTL",123,0)
S PSGSD=$S($G(P(2)):P(2),1:$G(PSGSD)) I $L(PSGSD)>6 S PSGSD=$$DATE2^PSJUTL2(PSGSD)
"RTN","PSJLIUTL",124,0)
S PSGFD=$S($G(P(3)):P(3),1:$G(PSGFD)) I $L(PSGFD)>6 S PSGFD=$$DATE2^PSJUTL2(PSGFD)
"RTN","PSJLIUTL",125,0)
I $G(PSGSD),$G(PSGRDTX(+ORDER,"PSGSD")) I
(","_PSGRDTX(+ORDER,"PSGSD")_","_PSGRDTX(+ORDER,"PSGRSD")_",")'[(","_PSGSD_",") D
"RTN","PSJLIUTL",126,0)
. S PSGRDTX(+ORDER,"PSGSD")=PSGSD
"RTN","PSJLIUTL",127,0)
I $G(PSGFD),$G(PSGRDTX(+ORDER,"PSGFD")) I
(","_PSGRDTX(+ORDER,"PSGFD")_","_PSGRDTX(+ORDER,"PSGRFD")_",")'[(","_PSGFD_",") D
"RTN","PSJLIUTL",128,0)
. S PSGRDTX(+ORDER,"PSGFD")=PSGFD
"RTN","PSJLIUTL",129,0)
I $G(PSGSD),'$G(PSGRDTX(+ORDER,"PSGSD")) D
"RTN","PSJLIUTL",130,0)
. S PSGRSD=$S($G(PSGRDTX(+ORDER,"PSGRSD")):PSGRDTX(+ORDER,"PSGRSD"),1:$P(PSGRDTX,U))
Q:'PSGRSD
"RTN","PSJLIUTL",131,0)
. S A=PSGRSD,PSGRSD=PSGSD,PSGSD=A
"RTN","PSJLIUTL",132,0)
. S PSGRDTX(+ORDER,"PSGRSD")=PSGRSD,PSGRDTX(+ORDER,"PSGSD")=PSGSD I $G(P(4))]"",PSGSD]"" S
P(2)=PSGSD
"RTN","PSJLIUTL",133,0)
. I PARENT,($P($G(PSGSRDTX),"^",3)="") S PSGNESD=PSGSD
"RTN","PSJLIUTL",134,0)
I $G(PSGFD),'$G(PSGRDTX(+ORDER,"PSGFD")) D
"RTN","PSJLIUTL",135,0)
. S PSGRFD=$S($D(PSGRDTX(+ORDER,"PSGRFD")):PSGRDTX(+ORDER,"PSGRFD"),1:$P(PSGRDTX,U,3))
Q:'PSGRFD
"RTN","PSJLIUTL",136,0)
. S A=PSGRFD,PSGRFD=$S($G(PSGFD):PSGFD,1:$G(PSGNEFD)),PSGFD=A
"RTN","PSJLIUTL",137,0)
. S PSGRDTX(+ORDER,"PSGRFD")=PSGRFD,(PSGNEFD,PSGRDTX(+ORDER,"PSGFD"))=PSGFD I
$G(P(4))]"",PSGFD]"" S P(3)=PSGFD
"RTN","PSJLIUTL",138,0)
S PSGSD=$S($G(PSGRDTX(+ORDER,"PSGSD")):PSGRDTX(+ORDER,"PSGSD"),1:$G(PSGSD)) I
$G(P(4))]"",$L(PSGSD)>6 S P(2)=$$DATE2^PSJUTL2(PSGSD)
"RTN","PSJLIUTL",139,0)
I $G(PSGSD) S PSGSDN=$$ENDD^PSGMI(PSGSD)_U_$$ENDTC2^PSGMI(PSGSD) ;#373 ENDTC2 call
replaces ENDTC call
"RTN","PSJLIUTL",140,0)
S PSGRSD=$S($G(PSGRDTX(+ORDER,"PSGRSD")):PSGRDTX(+ORDER,"PSGRSD"),1:$G(PSGRSD))
"RTN","PSJLIUTL",141,0)
I $G(PSGRSD) S PSGRSDN=$$ENDTC^PSGMI(PSGRSD)
"RTN","PSJLIUTL",142,0)
I $G(PSGRDTX(+ORDER,"PSGFD")),$G(PSGSD) I PSGSD>PSGRDTX(+ORDER,"PSGFD") N DUR S
DUR=$P($G(PSGRDTX),U,2) D
"RTN","PSJLIUTL",143,0)
. N DURMIN S DURMIN=$$DURMIN^PSJLIVMD(DUR) S
(PSGFD,PSGRDTX(+ORDER,"PSGFD"))=$$FMADD^XLFDT(PSGSD,,,$S(DURMIN:DURMIN,1:1440))
"RTN","PSJLIUTL",144,0)
S PSGFD=$S($G(PSGRDTX(+ORDER,"PSGFD")):PSGRDTX(+ORDER,"PSGFD"),1:$G(PSGFD)) D
"RTN","PSJLIUTL",145,0)
. I PSGFD<PSGSD,$G(PSGFD),ORDER'["V" N PSGST I $G(DFN) S
PSGST=$S(PSGORD["P":$P(^PS(53.1,+PSGORD,0),"^",7),1:$P(^PS(55,DFN,5,+PSGORD,0),"^",7)) D
"RTN","PSJLIUTL",146,0)
.. D ENFD^PSGNE3(PSGSD) I PSGNEFD>PSGSD S PSGFD=PSGNEFD
"RTN","PSJLIUTL",147,0)
. I PSGFD<PSGSD,$G(PSGFD),ORDER["V" D ENSTOP^PSIVCAL I P(3)>P(2) S PSGFD=P(3)
"RTN","PSJLIUTL",148,0)
. I $G(P(4))]"",$L(PSGFD)>6 S P(3)=$$DATE2^PSJUTL2(PSGFD)
"RTN","PSJLIUTL",149,0)
I $G(PSGFD) S PSGFDN=$$ENDD^PSGMI(PSGFD)_U_$$ENDTC2^PSGMI(PSGFD) ;#373 ENDTC2 call
replaces ENDTC call
"RTN","PSJLIUTL",150,0)
S PSGRFD=$S($G(PSGRDTX(+ORDER,"PSGRFD")):PSGRDTX(+ORDER,"PSGRFD"),1:$G(PSGRFD))
"RTN","PSJLIUTL",151,0)
I $G(PSGRFD) S PSGRFDN=$$ENDTC^PSGMI(PSGRFD)
"RTN","PSJLIUTL",152,0)
Q
"RTN","PSJLIVFD")
0^14^B65805635^B65804715
"RTN","PSJLIVFD",1,0)
PSJLIVFD ;BIR/MV - SETUP LM TEMPLATE FOR IV FLUID ;Jul 02, 2018@09:49
"RTN","PSJLIVFD",2,0)
;;5.0;INPATIENT
MEDICATIONS;**7,50,63,64,58,81,91,80,116,110,111,180,134,181,254,267,228,279,305,256,373**;16
DEC 97;Build 3
"RTN","PSJLIVFD",3,0)
;
"RTN","PSJLIVFD",4,0)
; External Reference to ^VALM0 is supported by DBIA #2615.
"RTN","PSJLIVFD",5,0)
; External Referece to ^PS(53.47 is supported by DBIA #5884
"RTN","PSJLIVFD",6,0)
;
"RTN","PSJLIVFD",7,0)
;NFI changes for FR# 3@AD+4
"RTN","PSJLIVFD",8,0)
;
"RTN","PSJLIVFD",9,0)
EN ; Build LM template to display IV order.
"RTN","PSJLIVFD",10,0)
K ^TMP("PSJI",$J) N SCHMSG
"RTN","PSJLIVFD",11,0)
S UL80="",$P(UL80,"=",80)=""
"RTN","PSJLIVFD",12,0)
S PSJLN=1
"RTN","PSJLIVFD",13,0)
AD ;
"RTN","PSJLIVFD",14,0)
NEW VALMEVL S VALMEVL=1
"RTN","PSJLIVFD",15,0)
S PSJL="" D FLDNO^PSJLIUTL("(1)",1)
"RTN","PSJLIVFD",16,0)
S PSJL=PSJL_"Additives:"
"RTN","PSJLIVFD",17,0)
S:$G(P("PON"))["V"&(P(17)'="N") PSJL=$$SETSTR^VALM1("Order number:",PSJL,30,14)_+P("PON")
"RTN","PSJLIVFD",18,0)
S PSJL=$$SETSTR^VALM1("Type:",PSJL,54,6)_$$TYPE^PSJLIUTL
"RTN","PSJLIVFD",19,0)
NEW PSJVD S PSJVD=$$DINFLIV^PSJDIN(.DRG) S PSJVD=$TR(PSJVD," ")
"RTN","PSJLIVFD",20,0)
I $D(^TMP("PSJINTER",$J))!$$OVRCHK^PSGSICH1(PSGP,$G(PSJORD)) S
PSJVD=$S($G(PSJVD)["DIN":"<OCI><DIN>",1:"<OCI>")
"RTN","PSJLIVFD",21,0)
S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,(80-$L(PSJVD)),$L(PSJVD))
"RTN","PSJLIVFD",22,0)
I $D(IORVON),($G(PSJVD)]"") D CNTRL^VALM10(1,(80-$L(PSJVD)),$L(PSJVD),IORVON,IORVOFF,0) K
PSJVD
"RTN","PSJLIVFD",23,0)
I '$D(IORVON),$D(IOST(0)) D ENS^%ZISS,TERM^VALM0
"RTN","PSJLIVFD",24,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",25,0)
D:+$G(PSJLMX) CLRDSPL^PSJLIVMD
"RTN","PSJLIVFD",26,0)
;PSJLMX count number of lines needed to display the add/sol
"RTN","PSJLIVFD",27,0)
S PSJLMX=0 D WRTDRG^PSJLIUTL("AD")
"RTN","PSJLIVFD",28,0)
SOL ;
"RTN","PSJLIVFD",29,0)
S PSJL="" D FLDNO^PSJLIUTL("(2)",1)
"RTN","PSJLIVFD",30,0)
S PSJL=PSJL_"Solutions:"
"RTN","PSJLIVFD",31,0)
I P("SYRS")]"" D
"RTN","PSJLIVFD",32,0)
. S PSJL=$$SETSTR^VALM1("Syr. Size:",PSJL,52,10)_$E(P("SYRS"),1,13)
"RTN","PSJLIVFD",33,0)
. S:$L(P("SYRS"))>13 PSJL=PSJL_"..."
"RTN","PSJLIVFD",34,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",35,0)
D WRTDRG^PSJLIUTL("SOL")
"RTN","PSJLIVFD",36,0)
DUR ;
"RTN","PSJLIVFD",37,0)
S PSJL=""
"RTN","PSJLIVFD",38,0)
N DUROUT,IVLIMIT S DUROUT=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,$S(PSJORD["P":"P",1:"IV"))
"RTN","PSJLIVFD",39,0)
I $G(PSJORD)["P" N ND25 S ND25=$G(^PS(53.1,+PSJORD,2.5)),IVLIMIT=$P(ND25,"^",4) D
"RTN","PSJLIVFD",40,0)
.S IVLIMIT=$S(IVLIMIT]"":$$FMTDUR^PSJLIVMD(IVLIMIT),1:"") S:IVLIMIT]"" DUROUT=IVLIMIT
"RTN","PSJLIVFD",41,0)
S LABEL=$S($G(IVLIMIT):"IV Limit: ",1:"Duration: ") K IVLIMIT
"RTN","PSJLIVFD",42,0)
S PSJL=$$SETSTR^VALM1(LABEL,PSJL,12,10)
"RTN","PSJLIVFD",43,0)
S PSJL=PSJL_DUROUT
"RTN","PSJLIVFD",44,0)
START ;
"RTN","PSJLIVFD",45,0)
D FLDNO^PSJLIUTL("(4)",47)
"RTN","PSJLIVFD",46,0)
;S PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT^PSJLIUTL ;373
"RTN","PSJLIVFD",47,0)
S PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT2^PSJLIUTL ;373
"RTN","PSJLIVFD",48,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",49,0)
NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
"RTN","PSJLIVFD",50,0)
S PSJL="" I $G(PSJORD)["P",$G(PSGRDTX) D
"RTN","PSJLIVFD",51,0)
. N RSDLABL,PSJRQB,PSJRQL,PSGRSD,PSGSRSDN
"RTN","PSJLIVFD",52,0)
. S RSDLABL=" REQUESTED START: ",PSJRQB=41,PSJRQL=39,PSGRSD="",PSGRSDN=""
"RTN","PSJLIVFD",53,0)
. I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$G(P(2)) S PSJRQB=51,PSJRQL=29 D
"RTN","PSJLIVFD",54,0)
.. S PSGRSD=PSGRDTX(+$G(PSJORD),"PSGRSD"),PSGRSDN=$$ENDTC^PSGMI(+PSGRSD),RSDLABL="Calc
Start: "
"RTN","PSJLIVFD",55,0)
. I '$G(P(2)),'$P(PSGRDTX,U,3) S PSGRSD=+PSGRDTX,PSGRSDN=$$ENDTC^PSGMI(PSGRSD)
"RTN","PSJLIVFD",56,0)
. I $G(PSGRSD),($G(PSGRSDN)]"") D
DSPLYDT^PSJLIVMD(PSJLMX+5,.PSGRSD,.PSGRSDN,RSDLABL,1,PSJRQB,PSJRQL),SETTMP^PSJLMPRU("PSJI
",PSJL)
"RTN","PSJLIVFD",57,0)
INFRATE ;
"RTN","PSJLIVFD",58,0)
N INFLBL,INFLBL1,INFLBL2 S INFLBL="",INFLBL1="",$P(INFLBL2," ",20)=""
"RTN","PSJLIVFD",59,0)
S PSJL="" D FLDNO^PSJLIUTL("(3)",1)
"RTN","PSJLIVFD",60,0)
S PSJL=$$SETSTR^VALM1("Infusion Rate:",PSJL,7,15)
"RTN","PSJLIVFD",61,0)
I ($G(P("NUMLBL"))?1.N) S INFLBL1=" ("_P("NUMLBL")_" label"_$S(P("NUMLBL")=1:"",1:"s")_" per day)"
I $L(P(8))>13 S INFLBL1=$E(INFLBL2,1,(24-$L(P(8))))_INFLBL1
"RTN","PSJLIVFD",62,0)
S INFLBL=$S('($G(P("NUMLBL"))?1.N):$P(P(8),"@"),1:$P(P(8),"@")_INFLBL1)
"RTN","PSJLIVFD",63,0)
D LONG^PSJLIUTL(INFLBL,22,24)
"RTN","PSJLIVFD",64,0)
LASTREN ;
"RTN","PSJLIVFD",65,0)
N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,$S($G(PSJORD):PSJORD,1:$G(ON))) I PSGRNDT D
"RTN","PSJLIVFD",66,0)
. ;S PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32)
;#373
"RTN","PSJLIVFD",67,0)
. S PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed:
"_PSGRNDT,PSJL,54,32) ;#373
"RTN","PSJLIVFD",68,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",69,0)
MR ;
"RTN","PSJLIVFD",70,0)
S PSJL="" D FLDNO^PSJLIUTL("(5)",1)
"RTN","PSJLIVFD",71,0)
S PSJL=$$SETSTR^VALM1("Med Route:",PSJL,11,11)
"RTN","PSJLIVFD",72,0)
S PSJL=PSJL_$P(P("MR"),U,2)
"RTN","PSJLIVFD",73,0)
STOP ;
"RTN","PSJLIVFD",74,0)
D FLDNO^PSJLIUTL("(6)",47)
"RTN","PSJLIVFD",75,0)
;PSJ*5*180 - If Invalid Duration/Limit - Cannot Calculate Stop Date
"RTN","PSJLIVFD",76,0)
;S PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$S($G(PSJBADD)=1:"CANNOT
CALCULATE",1:$$STOPDT^PSJLIUTL) ;#373
"RTN","PSJLIVFD",77,0)
S PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$S($G(PSJBADD)=1:"CANNOT
CALCULATE",1:$$STOPDT2^PSJLIUTL) ;#373
"RTN","PSJLIVFD",78,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",79,0)
S PSJL=""
"RTN","PSJLIVFD",80,0)
N PSJBCMA S PSJBCMA=$$BCMALG^PSJUTL2(DFN,PSJORD)
"RTN","PSJLIVFD",81,0)
I $G(PSJBCMA)]"" S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
"RTN","PSJLIVFD",82,0)
;I $G(PSGRDTX(+PSJORD,"PSGRFD")) S
PSGRFD=PSGRDTX(+PSJORD,"PSGRFD"),PSGRFDN=$$ENDTC^PSGMI(PSGRFD) D ;#373
"RTN","PSJLIVFD",83,0)
I $G(PSGRDTX(+PSJORD,"PSGRFD")) S
PSGRFD=PSGRDTX(+PSJORD,"PSGRFD"),PSGRFDN=$$ENDTC2^PSGMI(PSGRFD) D ;#373
"RTN","PSJLIVFD",84,0)
. D DSPLYDT^PSJLIVMD(PSJLMX+7,.PSGRFD,.PSGRFDN," Calc Stop: ",0,51,29)
"RTN","PSJLIVFD",85,0)
D:($G(PSJBCMA)]"")!($G(PSGRFD)]"") SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",86,0)
SCH ;
"RTN","PSJLIVFD",87,0)
S PSJL="" D FLDNO^PSJLIUTL("(7)",1)
"RTN","PSJLIVFD",88,0)
S PSJL=$$SETSTR^VALM1("Schedule:",PSJL,12,11)
"RTN","PSJLIVFD",89,0)
D LONG^PSJLIUTL(P(9)_$S(P(7):"@0 labels a day",1:"")_$G(SCHMSG),22,35)
"RTN","PSJLIVFD",90,0)
LASTFL ;
"RTN","PSJLIVFD",91,0)
S PSJL=$$SETSTR^VALM1("Last Fill:",PSJL,52,11)
"RTN","PSJLIVFD",92,0)
;S PSJL=PSJL_$$ENDTC^PSGMI(P("LF")) ;#373
"RTN","PSJLIVFD",93,0)
S PSJL=PSJL_$$ENDTC2^PSGMI(P("LF")) ;#373
"RTN","PSJLIVFD",94,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",95,0)
ADM ;
"RTN","PSJLIVFD",96,0)
S PSJL="" D FLDNO^PSJLIUTL("(8)",1)
"RTN","PSJLIVFD",97,0)
S PSJL=$$SETSTR^VALM1("Admin Times:",PSJL,9,14)
"RTN","PSJLIVFD",98,0)
D LONG^PSJLIUTL(P(11),22,30)
"RTN","PSJLIVFD",99,0)
QTY ;
"RTN","PSJLIVFD",100,0)
S PSJL=$$SETSTR^VALM1("Quantity:",PSJL,53,10)_+P("LFA")
"RTN","PSJLIVFD",101,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",102,0)
PROVIDER ;
"RTN","PSJLIVFD",103,0)
S PSJL="" D FLDNO^PSJLIUTL("(9)",1)
"RTN","PSJLIVFD",104,0)
S PSJL=$$SETSTR^VALM1("Provider:",PSJL,12,10)_$$PROVIDER^PSJLIUTL
"RTN","PSJLIVFD",105,0)
CUMDOSES ;
"RTN","PSJLIVFD",106,0)
S PSJL=$$SETSTR^VALM1("Cum. Doses:",PSJL,51,12)_P("CUM")
"RTN","PSJLIVFD",107,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",108,0)
OPI ;
"RTN","PSJLIVFD",109,0)
N PSJOPILN,PSJOPCNT
"RTN","PSJLIVFD",110,0)
S PSJL="" D FLDNO^PSJLIUTL("(10)",1)
"RTN","PSJLIVFD",111,0)
I $G(PSIVBR)["PSIVVW" D
"RTN","PSJLIVFD",112,0)
.S PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD,1)
"RTN","PSJLIVFD",113,0)
.I PSJOPILN=1,($TR($G(^TMP("PSJBCMA5",$J,DFN,PSJORD,1))," ")="") K
^TMP("PSJBCMA5",$J,DFN,PSJORD) S PSJOPILN=""
"RTN","PSJLIVFD",114,0)
.S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
"RTN","PSJLIVFD",115,0)
.S PSJL=PSJL_" "_$S(($G(PSJOPILN)>0):"(see below)",1:"")
"RTN","PSJLIVFD",116,0)
.D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",117,0)
.I (PSJOPILN>0) N PSJOPCNT S PSJOPCNT=0 F PSJOPCNT=1:1:PSJOPILN S PSJL="
"_$G(^TMP("PSJBCMA5",$J,DFN,PSJORD,PSJOPCNT)) D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",118,0)
I $G(PSIVBR)'["PSIVVW" D
"RTN","PSJLIVFD",119,0)
.I $G(ON55)["P",$G(PSJORD)["V",$P($G(^PS(53.1,+ON55,0)),"^",25)=PSJORD S
PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,ON55)
"RTN","PSJLIVFD",120,0)
.S PSJOPILN=$P($G(^PS(53.45,PSJSYSP,6,0)),"^",3) I 'PSJOPILN S
PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD)
"RTN","PSJLIVFD",121,0)
.I PSJOPILN=1,($TR($G(^PS(53.45,PSJSYSP,6,1,0))," ")="") I '($G(^PS(53.45,PSJSYSP,6,0))<0) K
^PS(53.45,PSJSYSP,6) S PSJOPILN=""
"RTN","PSJLIVFD",122,0)
.S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
"RTN","PSJLIVFD",123,0)
.S PSJL=PSJL_$S((PSJOPILN>0)&'($G(^PS(53.45,PSJSYSP,6,0))<0):"(see below)",1:"")
"RTN","PSJLIVFD",124,0)
.D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",125,0)
.I PSJOPILN>0 N PSJOPCNT S PSJOPCNT=0 F PSJOPCNT=1:1:PSJOPILN S PSJL="
"_$G(^PS(53.45,PSJSYSP,6,PSJOPCNT,0)) D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",126,0)
K PSJOPILN,PSJOPCNT K PSJOPILN,PSJOPCNT
"RTN","PSJLIVFD",127,0)
PC ;
"RTN","PSJLIVFD",128,0)
S PSJL=""
"RTN","PSJLIVFD",129,0)
S PSJL=$$SETSTR^VALM1("Provider Comments:",PSJL,3,18) D WTPC^PSJLIUTL
"RTN","PSJLIVFD",130,0)
REMARK ;
"RTN","PSJLIVFD",131,0)
D SETTMP^PSJLMPRU("PSJI","")
"RTN","PSJLIVFD",132,0)
S PSJL="" D FLDNO^PSJLIUTL("(11)",1)
"RTN","PSJLIVFD",133,0)
S PSJL=$$SETSTR^VALM1("Remarks :",PSJL,8,10)
"RTN","PSJLIVFD",134,0)
D LONG^PSJLIUTL(P("REM"),18,62)
"RTN","PSJLIVFD",135,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",136,0)
IVROOM ;
"RTN","PSJLIVFD",137,0)
S PSJL=""
"RTN","PSJLIVFD",138,0)
S PSJL=$$SETSTR^VALM1("IV Room:",PSJL,9,9)_$P(P("IVRM"),U,2)
"RTN","PSJLIVFD",139,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",140,0)
ENTRY ;
"RTN","PSJLIVFD",141,0)
S PSJL="",PSJL=$$SETSTR^VALM1("Entry By:",PSJL,8,10)
"RTN","PSJLIVFD",142,0)
S PSJL=PSJL_$S($P(P("CLRK"),U,2)]"":$E($P(P("CLRK"),U,2),1,18),1:"*** Undefined")
"RTN","PSJLIVFD",143,0)
S PSJL=$$SETSTR^VALM1("Entry Date:",PSJL,51,12)_$$ENDTC^PSGMI(P("LOG"))
"RTN","PSJLIVFD",144,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",145,0)
S PSJL="" S PSGLRN=$$LASTRNBY^PSJLMPRI(DFN,$S($G(PSJORD):PSJORD,1:$G(ON))) I PSGLRN D
"RTN","PSJLIVFD",146,0)
. S PSJL=$$SETSTR^VALM1("Renewed By: ",PSJL,6,12)_$$ENNPN^PSGMI(PSGLRN) D
SETTMP^PSJLMPRU("PSJI",PSJL) K PSGLRN
"RTN","PSJLIVFD",147,0)
S VALM("TITLE")=$$CODES^PSIVUTL(P(17),$S($G(ON)["P":53.1,1:55.01),$S(ON["P":28,1:100))_" IV "
"RTN","PSJLIVFD",148,0)
I $G(P("PRY"))="D"!($G(P("PON"))["P") S
VALM("TITLE")=VALM("TITLE")_$S($G(P("PRY"))="":"",1:"("_$$CODES^PSIVUTL(P("PRY"),53.1,.24)_")")
"RTN","PSJLIVFD",149,0)
I $G(P("PON"))["P" D ORDCHK
"RTN","PSJLIVFD",150,0)
S VALMCNT=PSJLN-1,^TMP("PSJI",$J,0)=VALMCNT
"RTN","PSJLIVFD",151,0)
Q
"RTN","PSJLIVFD",152,0)
;
"RTN","PSJLIVFD",153,0)
ORDCHK ;Display order check for pending order
"RTN","PSJLIVFD",154,0)
Q:'$O(^PS(53.1,+ON,10,0))
"RTN","PSJLIVFD",155,0)
NEW PSJIVX,PSJIVXX
"RTN","PSJLIVFD",156,0)
F PSJIVX=0:0 S PSJIVX=$O(^PS(53.1,+ON,10,PSJIVX)) Q:'PSJIVX D
"RTN","PSJLIVFD",157,0)
. D SETTMP^PSJLMPRU("PSJI","")
"RTN","PSJLIVFD",158,0)
. S PSJL="CPRS Order Checks :" D LONG^PSJLIUTL($G(^PS(53.1,+ON,10,PSJIVX,0)),22,58)
"RTN","PSJLIVFD",159,0)
. D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",160,0)
. S PSJL="Overriding Provider: "_$P($G(^PS(53.1,+ON,10,PSJIVX,1)),U)
"RTN","PSJLIVFD",161,0)
. D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVFD",162,0)
. S PSJL="Overriding Reason : "
"RTN","PSJLIVFD",163,0)
. F PSJIVXX=0:0 S PSJIVXX=$O(^PS(53.1,+ON,10,PSJIVX,2,PSJIVXX)) Q:'PSJIVXX D
"RTN","PSJLIVFD",164,0)
.. D LONG^PSJLIUTL($G(^PS(53.1,+ON,10,PSJIVX,2,PSJIVXX,0)),22,58)
"RTN","PSJLIVFD",165,0)
.. D SETTMP^PSJLMPRU("PSJI",PSJL) S PSJL=""
"RTN","PSJLIVFD",166,0)
Q
"RTN","PSJLIVFD",167,0)
;
"RTN","PSJLIVFD",168,0)
SCHREQ(IVAR) ; Intermittent IV's require a schedule
"RTN","PSJLIVFD",169,0)
I $G(IVAR(4))="P"!($G(IVAR(23))="P")!($G(IVAR(5))) Q 1
"RTN","PSJLIVFD",170,0)
Q 0
"RTN","PSJLIVFD",171,0)
;
"RTN","PSJLIVFD",172,0)
INFCHK(INFFULL,INFEXP) ; Parse and expand infusion rate
"RTN","PSJLIVFD",173,0)
;*305
"RTN","PSJLIVFD",174,0)
Q:INFFULL=""
"RTN","PSJLIVFD",175,0)
S INFEXP=INFFULL
"RTN","PSJLIVFD",176,0)
N I S I=$O(^PS(53.47,"B",INFFULL,0)) Q:'I S:$P($G(^PS(53.47,I,0)),"^",2)]"" INFEXP=$P(^(0),"^",2)
"RTN","PSJLIVFD",177,0)
Q
"RTN","PSJLIVFD",178,0)
INFEXP(INF) ; Expand Infusion Rate
"RTN","PSJLIVFD",179,0)
I $L(INF)<1!($L(INF)>30) Q INF
"RTN","PSJLIVFD",180,0)
N INFIEN,ARRAY
"RTN","PSJLIVFD",181,0)
S (INFIEN,ARRAY)=""
"RTN","PSJLIVFD",182,0)
N X,Y,DIC,DR,DA,DIQ
"RTN","PSJLIVFD",183,0)
S X=INF,DIC(0)="XO",DIC="^PS(53.47," D ^DIC I '($G(Y)>0) Q INF
"RTN","PSJLIVFD",184,0)
S INFIEN=+$G(Y)
"RTN","PSJLIVFD",185,0)
D GETS^DIQ(53.47,INFIEN_",",".01;1","E","ARRAY")
"RTN","PSJLIVFD",186,0)
I $G(ARRAY("53.47",INFIEN_",","1","E"))]"" Q ARRAY("53.47",INFIEN_",","1","E")
"RTN","PSJLIVFD",187,0)
Q INF
"RTN","PSJLIVMD")
0^15^B103647845^B103646863
"RTN","PSJLIVMD",1,0)
PSJLIVMD ;BIR/MV - SETUP LM TEMPLATE FOR INPT MED. IV ;Jul 02, 2018@09:53
"RTN","PSJLIVMD",2,0)
;;5.0;INPATIENT
MEDICATIONS;**37,50,63,58,81,91,80,116,110,111,180,134,209,254,267,275,279,373**;16 DEC
97;Build 3
"RTN","PSJLIVMD",3,0)
;
"RTN","PSJLIVMD",4,0)
;Reference to ^PS(55 is supported by DBIA #2191.
"RTN","PSJLIVMD",5,0)
;
"RTN","PSJLIVMD",6,0)
EN ; Build LM template to display IV order.
"RTN","PSJLIVMD",7,0)
I $G(ON55),($G(P(1))=+$G(ON55)) S PSJORD=ON55
"RTN","PSJLIVMD",8,0)
D GTOT^PSIVUTL(P(4))
"RTN","PSJLIVMD",9,0)
S:'$D(PSJSTAR) PSJSTAR="" S:'$D(PSGP) PSGP=DFN
"RTN","PSJLIVMD",10,0)
I $E(P("OT"))'="I" D EN^PSJLIVFD Q
"RTN","PSJLIVMD",11,0)
K ^TMP("PSJI",$J)
"RTN","PSJLIVMD",12,0)
S UL80="",$P(UL80,"=",80)=""
"RTN","PSJLIVMD",13,0)
S PSJLN=1
"RTN","PSJLIVMD",14,0)
I $G(PSIV531),P("PON")["P" S (P(2),P(3),P(4))=""
"RTN","PSJLIVMD",15,0)
AD ;
"RTN","PSJLIVMD",16,0)
NEW VALMEVL S VALMEVL=1
"RTN","PSJLIVMD",17,0)
S PSJL="" D FLDNO^PSJLIUTL("(1)",1)
"RTN","PSJLIVMD",18,0)
S PSJL=PSJL_" Additives:"
"RTN","PSJLIVMD",19,0)
S:$G(P("PON"))["V"&(P(17)'="N") PSJL=$$SETSTR^VALM1("Order number:",PSJL,28,14)_+P("PON")
"RTN","PSJLIVMD",20,0)
S PSJL=$$SETSTR^VALM1("Type:",PSJL,54,6)_$$TYPE^PSJLIUTL
"RTN","PSJLIVMD",21,0)
NEW PSJVD S PSJVD=$$DINFLIV^PSJDIN(.DRG) S PSJVD=$TR(PSJVD," ")
"RTN","PSJLIVMD",22,0)
I $D(^TMP("PSJINTER",$J))!$$OVRCHK^PSGSICH1(PSGP,$G(PSJORD)) S
PSJVD=$S($G(PSJVD)["DIN":"<OCI><DIN>",1:"<OCI>")
"RTN","PSJLIVMD",23,0)
S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,(80-$L(PSJVD)),$L(PSJVD))
"RTN","PSJLIVMD",24,0)
I $D(IORVON),($G(PSJVD)]"") D CNTRL^VALM10(1,(80-$L(PSJVD)),$L(PSJVD),IORVON,IORVOFF,0) K
PSJVD
"RTN","PSJLIVMD",25,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",26,0)
D:+$G(PSJLMX) CLRDSPL
"RTN","PSJLIVMD",27,0)
;PSJLMX count number of lines needed to display the add/sol
"RTN","PSJLIVMD",28,0)
S PSJLMX=0 D WRTDRG^PSJLIUTL("AD")
"RTN","PSJLIVMD",29,0)
SOL ;
"RTN","PSJLIVMD",30,0)
S PSJL="" D FLDNO^PSJLIUTL("(2)",1)
"RTN","PSJLIVMD",31,0)
S PSJL=PSJL_" Solutions:"
"RTN","PSJLIVMD",32,0)
I P("SYRS")]"" D
"RTN","PSJLIVMD",33,0)
. S PSJL=$$SETSTR^VALM1("Syr. Size:",PSJL,52,11)_$E(P("SYRS"),1,13)
"RTN","PSJLIVMD",34,0)
. S:$L(P("SYRS"))>13 PSJL=PSJL_"..."
"RTN","PSJLIVMD",35,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",36,0)
D WRTDRG^PSJLIUTL("SOL")
"RTN","PSJLIVMD",37,0)
D DUR
"RTN","PSJLIVMD",38,0)
START ;
"RTN","PSJLIVMD",39,0)
NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
"RTN","PSJLIVMD",40,0)
I $G(P("OT"))="I",$G(P(4))]"" D
"RTN","PSJLIVMD",41,0)
.I '$D(PSJSYSW0)!($$CLINIC^PSJO1($G(DFN),$G(ON))]"") N PSJSYSW0 S PSJSYSW0=$G(PSJSYSW0)
"RTN","PSJLIVMD",42,0)
.Q:$G(ON)["V" I $G(PSIVAC)="" N PSIVAC S PSIVAC="CF"
"RTN","PSJLIVMD",43,0)
.Q:$G(P(3))
"RTN","PSJLIVMD",44,0)
.D ENT^PSIVCAL,ENSTOP^PSIVCAL
"RTN","PSJLIVMD",45,0)
D REQDT(ON)
"RTN","PSJLIVMD",46,0)
D FLDNO^PSJLIUTL("(4)",47)
"RTN","PSJLIVMD",47,0)
;S PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT^PSJLIUTL ;#373
"RTN","PSJLIVMD",48,0)
S PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT2^PSJLIUTL ;#373
"RTN","PSJLIVMD",49,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",50,0)
INFRATE ;
"RTN","PSJLIVMD",51,0)
N INFLBL,INFLBL1,INFLBL2 S INFLBL="",INFLBL1="",$P(INFLBL2," ",20)=""
"RTN","PSJLIVMD",52,0)
S PSJL="" D FLDNO^PSJLIUTL("(3)",1)
"RTN","PSJLIVMD",53,0)
S PSJL=$$SETSTR^VALM1("Infusion Rate:",PSJL,7,15)
"RTN","PSJLIVMD",54,0)
I ($G(P("NUMLBL"))?1.N) S INFLBL1=" ("_P("NUMLBL")_" label"_$S(P("NUMLBL")=1:"",1:"s")_" per day)"
I $L(P(8))>13 S INFLBL1=$E(INFLBL2,1,(24-$L(P(8))))_INFLBL1
"RTN","PSJLIVMD",55,0)
S INFLBL=$S('($G(P("NUMLBL"))?1.N):$P(P(8),"@"),1:$P(P(8),"@")_INFLBL1)
"RTN","PSJLIVMD",56,0)
D LONG^PSJLIUTL(INFLBL,22,23)
"RTN","PSJLIVMD",57,0)
RSTART ;
"RTN","PSJLIVMD",58,0)
I $G(ON)["P" N PSGNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) D
"RTN","PSJLIVMD",59,0)
. ;I PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed:
"_PSGRNDT,PSJL,54,32) Q ;#373
"RTN","PSJLIVMD",60,0)
. I PSGRNDT S PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed:
"_PSGRNDT,PSJL,54,32) Q ;#373
"RTN","PSJLIVMD",61,0)
. Q:'$G(PSGRDTX) N PSJRQB,PSJRQL,RSDLABL,PSGRSD,PSGRSDN
"RTN","PSJLIVMD",62,0)
. S RSDLABL=" REQUESTED START: ",PSJRQB=41,PSJRQL=39,PSGRSD="",PSGRSDN=""
"RTN","PSJLIVMD",63,0)
. I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$G(P(2)) S PSJRQB=51,PSJRQL=29 D
"RTN","PSJLIVMD",64,0)
.. S PSGRSD=PSGRDTX(+$G(PSJORD),"PSGRSD"),PSGRSDN=$$ENDTC^PSGMI(+PSGRSD),RSDLABL="Calc
Start: "
"RTN","PSJLIVMD",65,0)
. I '$G(P(2)),'$P(PSGRDTX,U,3) S PSGRSD=+PSGRDTX,PSGRSDN=$$ENDTC^PSGMI(PSGRSD)
"RTN","PSJLIVMD",66,0)
. I $G(PSGRSD),($G(PSGRSDN)]"") D DSPLYDT(PSJLMX+5,.PSGRSD,.PSGRSDN,RSDLABL,1,PSJRQB,PSJRQL)
;,SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",67,0)
;I $G(ON)["V" N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) I PSGRNDT S
PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32)
;#373
"RTN","PSJLIVMD",68,0)
I $G(ON)["V" N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) I PSGRNDT S
PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32)
;#373
"RTN","PSJLIVMD",69,0)
I PSJL]"" D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",70,0)
;
"RTN","PSJLIVMD",71,0)
MR ;
"RTN","PSJLIVMD",72,0)
S PSJL="" D FLDNO^PSJLIUTL("(5)",1)
"RTN","PSJLIVMD",73,0)
S PSJL=$$SETSTR^VALM1("Med Route:",PSJL,11,11)
"RTN","PSJLIVMD",74,0)
S PSJL=PSJL_$P(P("MR"),U,2)
"RTN","PSJLIVMD",75,0)
STOP ;
"RTN","PSJLIVMD",76,0)
S:'$D(PSGP) PSGP=DFN
"RTN","PSJLIVMD",77,0)
D FLDNO^PSJLIUTL("(6)",47)
"RTN","PSJLIVMD",78,0)
;PSJ*5*180 - If CPRS sends invalid duration/limit - Cannot Calculate Stop Date.
"RTN","PSJLIVMD",79,0)
;S PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$S($G(PSJBADD)=1:"CANNOT
CALCULATE",1:$$STOPDT^PSJLIUTL) ;#373
"RTN","PSJLIVMD",80,0)
S PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$S($G(PSJBADD)=1:"CANNOT
CALCULATE",1:$$STOPDT2^PSJLIUTL) ;#373
"RTN","PSJLIVMD",81,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",82,0)
S PSJL=""
"RTN","PSJLIVMD",83,0)
N PSJBCMA S PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSJORD)
"RTN","PSJLIVMD",84,0)
I $G(PSJBCMA)]"",$G(DFN) S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
"RTN","PSJLIVMD",85,0)
I $G(PSJORD)["P",$G(PSGRDTX(+$G(PSJORD),"PSGRFD")),$G(P(3)) S
PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD")) D
"RTN","PSJLIVMD",86,0)
. D DSPLYDT(PSJLMX+7,.PSGRFD,.PSGRFDN," Calc Stop: ",1,51,29)
"RTN","PSJLIVMD",87,0)
I ($G(PSJBCMA)]"")!($G(PSGRDTX(+$G(PSJORD),"PSGRFD"))&$G(P(3))) D
SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",88,0)
SCH ;
"RTN","PSJLIVMD",89,0)
S PSJL="" D FLDNO^PSJLIUTL("(7)",1)
"RTN","PSJLIVMD",90,0)
S PSJL=$$SETSTR^VALM1("Schedule:",PSJL,12,11)
"RTN","PSJLIVMD",91,0)
D LONG^PSJLIUTL(P(9)_$S(P(7):"@0 labels a day",1:"")_$G(SCHMSG),22,31)
"RTN","PSJLIVMD",92,0)
LASTFL ;
"RTN","PSJLIVMD",93,0)
S PSJL=$$SETSTR^VALM1("Last Fill:",PSJL,52,11)
"RTN","PSJLIVMD",94,0)
;S PSJL=PSJL_$$ENDTC^PSGMI(P("LF")) ;#373
"RTN","PSJLIVMD",95,0)
S PSJL=PSJL_$$ENDTC2^PSGMI(P("LF")) ;#373
"RTN","PSJLIVMD",96,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",97,0)
ADM ;
"RTN","PSJLIVMD",98,0)
S PSJL="" D FLDNO^PSJLIUTL("(8)",1)
"RTN","PSJLIVMD",99,0)
S PSJL=$$SETSTR^VALM1("Admin Times:",PSJL,9,14)
"RTN","PSJLIVMD",100,0)
NEW NOECH
"RTN","PSJLIVMD",101,0)
D LONG^PSJLIUTL(P(11),22,29)
"RTN","PSJLIVMD",102,0)
QTY ;
"RTN","PSJLIVMD",103,0)
S PSJL=$$SETSTR^VALM1("Quantity:",PSJL,53,10)_+P("LFA")
"RTN","PSJLIVMD",104,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",105,0)
PROVIDER ;
"RTN","PSJLIVMD",106,0)
S PSJL="" D FLDNO^PSJLIUTL("(9)",1)
"RTN","PSJLIVMD",107,0)
S PSJL=$$SETSTR^VALM1("Provider:",PSJL,12,10)_$$PROVIDER^PSJLIUTL
"RTN","PSJLIVMD",108,0)
CUMDOSES ;
"RTN","PSJLIVMD",109,0)
S PSJL=$$SETSTR^VALM1("Cum. Doses:",PSJL,51,12)_P("CUM")
"RTN","PSJLIVMD",110,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",111,0)
OI ;
"RTN","PSJLIVMD",112,0)
S PSJL="" D FLDNO^PSJLIUTL("(10)",1)
"RTN","PSJLIVMD",113,0)
S PSJL=$$SETSTR^VALM1("Orderable Item:",PSJL,6,16)_$P(P("PD"),U,2)_$$OINF^PSJDIN(+P("PD"))
"RTN","PSJLIVMD",114,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",115,0)
INS ;
"RTN","PSJLIVMD",116,0)
S PSJL=""
"RTN","PSJLIVMD",117,0)
S PSJL=$$SETSTR^VALM1("Instructions:",PSJL,8,14)
"RTN","PSJLIVMD",118,0)
D LONG^PSJLIUTL(P("INS"),22,58)
"RTN","PSJLIVMD",119,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",120,0)
OPI ;
"RTN","PSJLIVMD",121,0)
S PSJL="" D FLDNO^PSJLIUTL("(11)",1)
"RTN","PSJLIVMD",122,0)
I $G(PSIVBR)["PSIVVW" D
"RTN","PSJLIVMD",123,0)
.S PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD,1)
"RTN","PSJLIVMD",124,0)
.I PSJOPILN=1,($TR($G(^TMP("PSJBCMA5",$J,DFN,PSJORD,1))," ")="") K
^TMP("PSJBCMA5",$J,DFN,PSJORD) S PSJOPILN="" Q
"RTN","PSJLIVMD",125,0)
.S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
"RTN","PSJLIVMD",126,0)
.S PSJL=PSJL_" "_$S(($G(PSJOPILN)>0):"(see below)",1:"")
"RTN","PSJLIVMD",127,0)
.D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",128,0)
.I (PSJOPILN>0) N PSJOPCNT S PSJOPCNT=0 F PSJOPCNT=1:1:PSJOPILN S PSJL="
"_$G(^TMP("PSJBCMA5",$J,DFN,PSJORD,PSJOPCNT)) D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",129,0)
I $G(PSIVBR)'["PSIVVW" D
"RTN","PSJLIVMD",130,0)
.I $G(ON55)["P",$G(PSJORD)["V",$P($G(^PS(53.1,+ON55,0)),"^",25)=PSJORD S
PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,ON55)
"RTN","PSJLIVMD",131,0)
.S PSJOPILN=$O(^PS(53.45,$G(PSJSYSP),6,""),-1) I 'PSJOPILN S
PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD)
"RTN","PSJLIVMD",132,0)
.I PSJOPILN=1,($TR($G(^PS(53.45,PSJSYSP,6,1,0))," ")="") I '($G(^PS(53.45,PSJSYSP,6,0))<0) K
^PS(53.45,PSJSYSP,6) S PSJOPILN="" Q
"RTN","PSJLIVMD",133,0)
.I PSJOPILN=1,$G(^PS(53.45,PSJSYSP,6,1,0))["Instructions too long. See Order View or BCMA for full
text." K ^PS(53.45,PSJSYSP,6) S PSJOPILN="" Q
"RTN","PSJLIVMD",134,0)
.S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
"RTN","PSJLIVMD",135,0)
.S PSJL=PSJL_" "_$S(($G(PSJOPILN)>0)&'($G(^PS(53.45,PSJSYSP,6,0))<0):"(see below)",1:"")
"RTN","PSJLIVMD",136,0)
.D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",137,0)
.I (PSJOPILN>0) N PSJOPCNT S PSJOPCNT=0 F PSJOPCNT=1:1:PSJOPILN S PSJL="
"_$G(^PS(53.45,DUZ,6,PSJOPCNT,0)) D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",138,0)
K PSJOPILN,PSJOPCNT
"RTN","PSJLIVMD",139,0)
PC ;
"RTN","PSJLIVMD",140,0)
S PSJL=""
"RTN","PSJLIVMD",141,0)
S PSJL=$$SETSTR^VALM1("Provider Comments:",PSJL,3,18) D WTPC^PSJLIUTL
"RTN","PSJLIVMD",142,0)
REMARK ;
"RTN","PSJLIVMD",143,0)
D SETTMP^PSJLMPRU("PSJI","")
"RTN","PSJLIVMD",144,0)
S PSJL="" D FLDNO^PSJLIUTL("(12)",1)
"RTN","PSJLIVMD",145,0)
S PSJL=$$SETSTR^VALM1("Remarks :",PSJL,8,10)
"RTN","PSJLIVMD",146,0)
D LONG^PSJLIUTL(P("REM"),18,62)
"RTN","PSJLIVMD",147,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",148,0)
IVROOM ;
"RTN","PSJLIVMD",149,0)
S PSJL=""
"RTN","PSJLIVMD",150,0)
S PSJL=$$SETSTR^VALM1("IV Room:",PSJL,9,9)_$P(P("IVRM"),U,2)
"RTN","PSJLIVMD",151,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",152,0)
ENTRY ;
"RTN","PSJLIVMD",153,0)
S PSJL="",PSJL=$$SETSTR^VALM1("Entry By:",PSJL,8,10)
"RTN","PSJLIVMD",154,0)
S PSJL=PSJL_$S($P(P("CLRK"),U,2)]"":$E($P(P("CLRK"),U,2),1,24),1:"*** Undefined")
"RTN","PSJLIVMD",155,0)
S PSJL=$$SETSTR^VALM1("Entry Date:",PSJL,51,12)_$$ENDTC^PSGMI(P("LOG"))
"RTN","PSJLIVMD",156,0)
D SETTMP^PSJLMPRU("PSJI",PSJL)
"RTN","PSJLIVMD",157,0)
S PSJL="" S PSGLRN=$$LASTRNBY^PSJLMPRI(DFN,$S($G(PSJORD):PSJORD,1:$G(ON))) I PSGLRN D
"RTN","PSJLIVMD",158,0)
. S PSJL=$$SETSTR^VALM1("Renewed By: ",PSJL,6,12)_$$ENNPN^PSGMI(PSGLRN) D
SETTMP^PSJLMPRU("PSJI",PSJL) K PSGLRN
"RTN","PSJLIVMD",159,0)
S VALM("TITLE")=$$CODES^PSIVUTL(P(17),$S($G(ON)["P":53.1,1:55.01),$S($G(ON)["P":28,1:100))_" IV "
"RTN","PSJLIVMD",160,0)
I $G(P("PRY"))="D"!($G(P("PON"))["P") S
VALM("TITLE")=VALM("TITLE")_$S($G(P("PRY"))="":"",1:"("_$$CODES^PSIVUTL(P("PRY"),53.1,.24)_")")
"RTN","PSJLIVMD",161,0)
I $G(P("PON"))["P" D ORDCHK^PSJLIVFD
"RTN","PSJLIVMD",162,0)
S VALMCNT=PSJLN-1,^TMP("PSJI",$J,0)=VALMCNT
"RTN","PSJLIVMD",163,0)
Q
"RTN","PSJLIVMD",164,0)
DSPLYDT(PSJLN,PSGRDT,PSGRDTN,TXT,PSJFSH,PSJRDBEG,PSJRDLEN) ;
"RTN","PSJLIVMD",165,0)
;LINE : Line number the Requested Start and Stop dates are display in
"RTN","PSJLIVMD",166,0)
;PSGRDT : Either it is the requested start or stop date in FM format
"RTN","PSJLIVMD",167,0)
;PSGRDTN: Either it is the requested start or stop date in IPM format
"RTN","PSJLIVMD",168,0)
;TXT : The display text
"RTN","PSJLIVMD",169,0)
;PSJFSH : if it is 1 then flash
"RTN","PSJLIVMD",170,0)
;
"RTN","PSJLIVMD",171,0)
S:'$G(PSJRDBEG) PSJRDBEG=41,PSJRDLEN=39
"RTN","PSJLIVMD",172,0)
S PSJL=$$SETSTR^VALM1(TXT_PSGRDTN,PSJL,PSJRDBEG,PSJRDLEN)
"RTN","PSJLIVMD",173,0)
Q
"RTN","PSJLIVMD",174,0)
CLRDSPL ;
"RTN","PSJLIVMD",175,0)
;Clear the blinking after edit the pending order.
"RTN","PSJLIVMD",176,0)
;Without it more than the requested start and stop dates are blinking at the ac/edit screen
"RTN","PSJLIVMD",177,0)
;PSJLMX: # ad/sol counted in WRTDRG^PSJLIUTL
"RTN","PSJLIVMD",178,0)
Q:'$D(IOBOFF)
"RTN","PSJLIVMD",179,0)
NEW PSJX
"RTN","PSJLIVMD",180,0)
F PSJX=5:1:PSJLMX+7 D CNTRL^VALM10(PSJX,36,80,IOBOFF,IOINORM)
"RTN","PSJLIVMD",181,0)
Q
"RTN","PSJLIVMD",182,0)
REQDT(ORDER) ;Get requested date if it is a pending order
"RTN","PSJLIVMD",183,0)
;ORDER : Pending Order Number (PSJORD or PSGORD)
"RTN","PSJLIVMD",184,0)
Q:ORDER'["P" D REQDT^PSJLIUTL(ORDER)
"RTN","PSJLIVMD",185,0)
Q
"RTN","PSJLIVMD",186,0)
;
"RTN","PSJLIVMD",187,0)
GETDUR(PAT,ORD,PKG,RAW) ;
"RTN","PSJLIVMD",188,0)
; PAT= Patient DFN
"RTN","PSJLIVMD",189,0)
; ORD= Order #
"RTN","PSJLIVMD",190,0)
; PKG= 5(UD), "IV"(IV), "P"(Pending)
"RTN","PSJLIVMD",191,0)
N ACT,DUR,ND,ND25,F25,ND0,ND2,OLDORD S DUR="",ORD=+ORD K IVLIMIT
"RTN","PSJLIVMD",192,0)
S:PKG="V" PKG="IV"
"RTN","PSJLIVMD",193,0)
I PKG="P" S ND=$G(^PS(53.1,+ORD,0)) D I '$G(OLDORD) Q DUR
"RTN","PSJLIVMD",194,0)
. I $G(P("OVRIDE")) S DUR="" Q
"RTN","PSJLIVMD",195,0)
. D PENDING(ORD) Q:DUR]""
"RTN","PSJLIVMD",196,0)
. S ND0=$G(^PS(53.1,ORD,0)) I $P(ND0,U,24)="E" S OLDORD=$P(ND0,U,25) I OLDORD S
PKG=$S(OLDORD["V":"IV",OLDORD["U":5,OLDORD["P":"P",1:"")
"RTN","PSJLIVMD",197,0)
. Q:($G(OLDORD)'["P")
"RTN","PSJLIVMD",198,0)
. D PENDING(OLDORD) S OLDORD=""
"RTN","PSJLIVMD",199,0)
I PKG="IV" S ND2=$G(^PS(55,PAT,PKG,ORD,2)) I $P(ND2,U,8)="E" S OLDORD=$P(ND2,U,5)
S:OLDORD'["V" OLDORD="" I OLDORD D
"RTN","PSJLIVMD",200,0)
.N ACTND S ACTND=0 F S ACTND=$O(^PS(55,PAT,"IV",ORD,"A",ACTND)) Q:'ACTND D
"RTN","PSJLIVMD",201,0)
..I $G(^PS(55,PAT,"IV",ORD,"A",ACTND,0))["IV LIMIT OVERRIDDEN" S OLDORD=""
"RTN","PSJLIVMD",202,0)
I $G(P("LIMIT"))]"" S DUR=P("LIMIT"),IVLIMIT=1 I '$G(RAW) S DUR=$$FMTDUR(DUR) Q DUR
"RTN","PSJLIVMD",203,0)
I PKG=5 S ND0=$G(^PS(55,PAT,PKG,ORD,0)) I $P(ND0,U,24)="E" S OLDORD=$P(ND0,U,25)
S:OLDORD'["U" OLDORD=""
"RTN","PSJLIVMD",204,0)
S F25="^PS(55,PAT,PKG,ORD,2.5)" I '$G(OLDORD) Q:'$D(@(F25)) DUR
"RTN","PSJLIVMD",205,0)
S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1
"RTN","PSJLIVMD",206,0)
;PSJ*5*209 stop forcing null duration to previous.
"RTN","PSJLIVMD",207,0)
;I DUR="",$G(OLDORD) S ORD=+OLDORD Q:'$D(@(F25)) DUR D
"RTN","PSJLIVMD",208,0)
;. S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1
"RTN","PSJLIVMD",209,0)
I '$G(RAW),DUR]"" S DUR=$$FMTDUR(DUR)
"RTN","PSJLIVMD",210,0)
Q DUR
"RTN","PSJLIVMD",211,0)
;
"RTN","PSJLIVMD",212,0)
PENDING(PNDON) ;
"RTN","PSJLIVMD",213,0)
S ND=$G(^PS(53.1,+ORD,0))
"RTN","PSJLIVMD",214,0)
I ND S ND25=$S(($P(ND,U,15)=PAT):$G(^PS(53.1,+ORD,2.5)),1:"")
"RTN","PSJLIVMD",215,0)
S DUR=$P(ND25,U,4) I DUR]"" D Q
"RTN","PSJLIVMD",216,0)
.S:($E(DUR)="s")!($E(DUR)="m")!($E(DUR)="l")!($E(DUR)="d")!($E(DUR)="h")!($E(DUR)="a") IVLIMIT=1
S DUR=$S($G(RAW):DUR,1:$$FMTDUR(DUR))
"RTN","PSJLIVMD",217,0)
S DUR=$P(ND25,U,2) I DUR]"" S DUR=$S($G(RAW):DUR,1:$$FMTDUR(DUR))
"RTN","PSJLIVMD",218,0)
Q
"RTN","PSJLIVMD",219,0)
;
"RTN","PSJLIVMD",220,0)
FMTDUR(DURCODE) ;
"RTN","PSJLIVMD",221,0)
N DUNIT,DNUM,BAD S BAD=0
"RTN","PSJLIVMD",222,0)
;PSJ*5*180 - Add PSJBADD variable
"RTN","PSJLIVMD",223,0)
K PSJBADD S PSJBADD=0
"RTN","PSJLIVMD",224,0)
S DUNIT=$E(DURCODE),DNUM=$P(DURCODE,DUNIT,2) I 'DNUM S BAD=1
"RTN","PSJLIVMD",225,0)
I DUNIT'="",DUNIT'?1(1U,1L) S PSJBADD=1
"RTN","PSJLIVMD",226,0)
S DUNIT=$S(DUNIT="D"!(DUNIT="d"):" day",DUNIT="H"!(DUNIT="h"):" hour",DUNIT="W":"
week",DUNIT="L":" month",DUNIT="M":" minute",DUNIT="S":" second",DUNIT="m":" ml",DUNIT="l":"
liter",DUNIT="a":" dose",1:"")
"RTN","PSJLIVMD",227,0)
S:DUNIT="" BAD=1 I (DNUM'=1),(DUNIT'["ml") S DUNIT=DUNIT_"s"
"RTN","PSJLIVMD",228,0)
I PSJBADD=1 S PSGACT=$TR($G(PSGACT),"F")
"RTN","PSJLIVMD",229,0)
Q $S(PSJBADD=1:"*INVALID DURATION/LIMIT*",BAD:"",1:DNUM_DUNIT)
"RTN","PSJLIVMD",230,0)
;
"RTN","PSJLIVMD",231,0)
DURMIN(DCOD) ;
"RTN","PSJLIVMD",232,0)
N DUR,DMIN,CHR S DUR="" F I=1:1:$L(DCOD) S CHR=$E(DCOD,I) I CHR?1N S DUR=DUR_CHR
"RTN","PSJLIVMD",233,0)
S DMIN=DUR*$S(DCOD["L":43200,DCOD["W":10080,DCOD["M":1,DCOD["S":(1/60),DCOD["D":1440,1:0)
S DMIN=+$FN(DMIN,"",1)
"RTN","PSJLIVMD",234,0)
Q DMIN
"RTN","PSJLIVMD",235,0)
;
"RTN","PSJLIVMD",236,0)
DUR ;
"RTN","PSJLIVMD",237,0)
N DUROUT,LABEL,IVLIMIT
"RTN","PSJLIVMD",238,0)
Q:'$G(PSJORD) S PSJL=""
"RTN","PSJLIVMD",239,0)
S DUROUT=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,$S(PSJORD["P":"P",1:"IV"))
"RTN","PSJLIVMD",240,0)
S LABEL=$S($G(IVLIMIT):"IV Limit: ",1:"Duration: ") K IVLIMIT
"RTN","PSJLIVMD",241,0)
S PSJL=$$SETSTR^VALM1(LABEL,PSJL,12,10)
"RTN","PSJLIVMD",242,0)
S PSJL=PSJL_DUROUT
"RTN","PSJLIVMD",243,0)
Q
"RTN","PSJLMGUD")
0^16^B31955674^B31955440
"RTN","PSJLMGUD",1,0)
PSJLMGUD ;BIR/MLM - INITIALIZE UNIT DOSE ORDER FIELDS FOR DISPLAY ;Jul 02, 2018@10:03
"RTN","PSJLMGUD",2,0)
;;5.0;INPATIENT MEDICATIONS;**25,58,85,116,110,111,267,275,315,256,373**;16 DEC 97;Build 3
"RTN","PSJLMGUD",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","PSJLMGUD",4,0)
; Reference to ^PS(51.2 is supported by DBIA 2178
"RTN","PSJLMGUD",5,0)
; Reference to ^PSDRUG( is supported by DBIA 2192
"RTN","PSJLMGUD",6,0)
; Reference to ^PS(55 is supported by DBIA 2191
"RTN","PSJLMGUD",7,0)
; Reference to ES^ORX8 is supported by DBIA 3632
"RTN","PSJLMGUD",8,0)
;
"RTN","PSJLMGUD",9,0)
GETUD(DFN,PSGORD) ;
"RTN","PSJLMGUD",10,0)
;
"RTN","PSJLMGUD",11,0)
EN2 ;
"RTN","PSJLMGUD",12,0)
N %X,%Y,ND2,ND2P1,DO,DRGI,FD,FL,FQC,NF,ND,PRI,SD,SIG,ST,STD,X,Y,ESIG ;*315
"RTN","PSJLMGUD",13,0)
K GMRAL,P
"RTN","PSJLMGUD",14,0)
S NF=$S(PSGORD["U":0,PSGORD["A":0,PSGORD["O":0,1:1) I
NF,$D(^PS(53.1,+PSGORD,0)),$P(^(0),"^",19),$D(^PS(55,DFN,5,$P(^(0),"^",19))),(+$P(^(0),"^",19)'=+$P(^
(0),"^",25)) S PSGORD=+$P(^PS(53.1,+PSGORD,0),"^",19)_"U",NF=0
"RTN","PSJLMGUD",15,0)
S (FL,Y)="",$P(FL,"-",71)="",PSGOEEWF="^PS("_$S(NF:"53.1,",1:"55,"_DFN_",5,")_+PSGORD_","
"RTN","PSJLMGUD",16,0)
; The naked reference on the line below refers to the full reference created by indirect reference to F,
where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
"RTN","PSJLMGUD",17,0)
S
ND=$G(@(PSGOEEWF_"0)")),ND2=$G(^(2)),ND2P1=$G(^(2.1)),PSGEB=$P($G(^(4)),"^",7),PSGOSI=$G(^(6
)),SIG=$G(^(6.5)),DO=$G(^(.2)),PSGOINST=$G(^(.3)),ESIG=$P(DO,U,3),PSG14=$P($G(^(14,0)),"^",3) ;*315
"RTN","PSJLMGUD",18,0)
I PSG14 S PSGLRN=$G(@(PSGOEEWF_"14,"_PSG14_",0)"))
"RTN","PSJLMGUD",19,0)
S
PSGOPD=+DO,PSGODO=$P(DO,U,2),PSGOPDN=$$OINAME^PSJLMUTL(+DO),X=$P(DO,U,4),PSGPRIO=$P(
"STAT^ASAP^ROUTINE^PREOP^TIME CRITICAL^DONE",U,$F("SARPTD",X)-1),PSJPRI=X
"RTN","PSJLMGUD",20,0)
S
PSGOPR=$P(ND,"^",2),PSGOMR=$P(ND,"^",3),PSGOSM=$P(ND,"^",5),PSGOHSM=$P(ND,"^",6),(PSGOST,
ST)=$P(ND,"^",7),STT=$P(ND,"^",9),PSGOMRN=$S('PSGOMR:"",1:$P($G(^PS(51.2,PSGOMR,0)),"^"))
S:PSGOMRN="" PSGOMRN=PSGOMR
"RTN","PSJLMGUD",21,0)
S
PSGLI=$P(ND,U,16),PSGOSCH=$P(ND2,"^"),(PSGOSD,SD)=$P(ND2,"^",2),(FD,PSGOFD)=$P(ND2,"^",4),(FQ
C,PSGS0XT)=$P(ND2,"^",6),(PSGOAT,PSGS0Y)=$P(ND2,"^",5)
"RTN","PSJLMGUD",22,0)
S:ND2P1]""
PSGDUR=$P(ND2P1,U,1),PSGRMVT=$P(ND2P1,U,2),PSGRMV=$P(ND2P1,U,3),PSGRF=$P(ND2P1,U,4)
;*315
"RTN","PSJLMGUD",23,0)
S PSGLIN=$$ENDD^PSGMI(PSGLI)_U_$$ENDTC^PSGMI(PSGLI)
"RTN","PSJLMGUD",24,0)
S
PRI=$S('PSGOPR:0,1:$P($G(^VA(200,PSGOPR,"PS")),"^",4)),DRGI=$S(PSGOPD'=+PSGOPD:0,1:+$G(^PSDR
UG(+PSGOPD,"I"))) S:PRI PRI=DT'<PRI S:DRGI DRGI=DT'<DRGI
"RTN","PSJLMGUD",25,0)
S PSGOPRN=$S('PSGOPR:"",1:$P($G(^VA(200,PSGOPR,0)),"^")) S:PSGOPRN="" PSGOPRN=PSGOPR I
PSGOSI]"" S PSGOSI=$$ENSET^PSGSICHK(PSGOSI)
"RTN","PSJLMGUD",26,0)
I $L($T(ES^ORX8)) N ESIG1 S ESIG1=$$ES^ORX8(+$P(ND,U,21)_";1") S:ESIG1=1 ESIG="ES"
"RTN","PSJLMGUD",27,0)
S PSGOPRN=PSGOPRN_$S(ESIG]"":" ["_$$LOW^XLFSTR(ESIG)_"]",1:"")
"RTN","PSJLMGUD",28,0)
S PSGEBN=$$ENNPN^PSGMI(PSGEB) S:$P(ND,U,27)="R" STT="R"
"RTN","PSJLMGUD",29,0)
S X=STT,PSGSTAT=$S(X="":"NOT FOUND",X="DE":"DISCONTINUED (EDIT)",X="DR":"DISCONTINUED
(RENEWAL)",X="RE":"REINSTATED",1:$P(X_"^ACTIVE^DISCONTINUED^EXPIRED^HOLD^INCOMPLETE^N
ON-VERIFIED^PENDING^RENEWED^UNRELEASED","^",$F("ADEHINPRU",X)))
"RTN","PSJLMGUD",30,0)
;
"RTN","PSJLMGUD",31,0)
SET ;
"RTN","PSJLMGUD",32,0)
I STT="P" S (FD,SD,ST)=""
"RTN","PSJLMGUD",33,0)
;S PSGOSTN=$$ENSTN^PSGMI(ST),(PSGOFDN,PSGOSDN)="" I SD S
PSGOSDN=$$ENDD^PSGMI(SD)_"^"_$$ENDTC^PSGMI(SD) ;#373
"RTN","PSJLMGUD",34,0)
;I FD S PSGOFDN=$$ENDD^PSGMI(FD)_"^"_$$ENDTC^PSGMI(FD) ;#373
"RTN","PSJLMGUD",35,0)
S PSGOSTN=$$ENSTN^PSGMI(ST),(PSGOFDN,PSGOSDN)="" I SD S
PSGOSDN=$$ENDD^PSGMI(SD)_"^"_$$ENDTC2^PSGMI(SD) ;#373
"RTN","PSJLMGUD",36,0)
I FD S PSGOFDN=$$ENDD^PSGMI(FD)_"^"_$$ENDTC2^PSGMI(FD) ;#373
"RTN","PSJLMGUD",37,0)
F
X="PD","PDN","MR","MRN","ST","STN","SCH","SI","SD","SDN","FD","FDN","SM","HSM","PR","PRN","DO
","AT" S @("PSG"_X)=@("PSGO"_X)
"RTN","PSJLMGUD",38,0)
K ^PS(53.45,PSJSYSP,1),^(2),^(5),^(6) S %X=PSGOEEWF_"3,",%Y="^PS(53.45,"_PSJSYSP_",1," D
%XY^%RCR S %X=PSGOEEWF_"1,",%Y="^PS(53.45,"_PSJSYSP_",2," D %XY^%RCR
"RTN","PSJLMGUD",39,0)
S $P(^PS(53.45,PSJSYSP,2,0),"^",2)="53.4502P"
"RTN","PSJLMGUD",40,0)
K PSJNSS I $G(PSGSCH)'="" D K PSJNSS
"RTN","PSJLMGUD",41,0)
. N PSGS0XTO,Y,PSGOES S X=PSGSCH S PSGS0XTO=PSGS0XT N PSGOSCH S PSGOSCH=PSGSCH S
PSGSCH="",PSGOES=1
"RTN","PSJLMGUD",42,0)
. ;D ENOS^PSGS0 S:$G(X)="" PSGS0XT=PSGS0XTO S
PSGSCH=$S($G(X)]""&($G(PSGS0XT)="D"):X,1:PSGOSCH) ;PSJ*5*256
"RTN","PSJLMGUD",43,0)
. D ENOS^PSGS0 S:$G(X)="" PSGS0XT=PSGS0XTO S PSGSCH=PSGOSCH
"RTN","PSJLMGUD",44,0)
Q
"RTN","PSJLMGUD",45,0)
;
"RTN","PSJLMGUD",46,0)
FINISH ;
"RTN","PSJLMGUD",47,0)
I '$G(PSGS0XT),PSGOSCH]"" D S $P(^PS(53.1,+PSGORD,2),"^",6)=PSGS0XT
"RTN","PSJLMGUD",48,0)
.N PSGOES,PSGS0Y S X=PSGOSCH,PSGOES=1 D ENOS^PSGS0
"RTN","PSJLMGUD",49,0)
S PSGOEFF=PSGOSCH=""+('$O(^PS(53.45,PSJSYSP,2,0))*10) I PSGOEFF S X=$S(PSGOEFF#2:" a
SCHEDULE",1:"")_$S(PSGOEFF=11:" and",1:"")_$S(PSGOEFF>9:" at least one DISPENSE DRUG",1:"")_"
before it can be finished."
"RTN","PSJLMGUD",50,0)
I PSGOEFF W $C(7),!!,"PLEASE NOTE: This order must have" F Q=1:1:$L(X," ") S Y=$P(X," ",Q)
W:$L(Y)+$X>78 ! W Y," "
"RTN","PSJLMGUD",51,0)
I PSGOEFF#2 S
F1=53.1,MSG=0,Y=$T(35),@("PSGFN(35)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1
W ! D @$P($T(35),";",3) G:'PSGOEE DONE
"RTN","PSJLMGUD",52,0)
I PSGOEFF>9 S CHK=7 D ENDRG^PSGOEF1(PSGOPD,0) G:CHK DONE
"RTN","PSJLMGUD",53,0)
I $G(MSG) K DIR S DIR(0)="E" W !! D ^DIR
"RTN","PSJLMGUD",54,0)
I PSGOEFF D:PSGST="" GTST^PSGOE6(+PSGORD) N XQORM D EN^VALM("PSJ LM OE DISPLAY") G DONE
;D ENW^PSGOEEW
"RTN","PSJLMGUD",55,0)
;
"RTN","PSJLMGUD",56,0)
ACCEPT ;
"RTN","PSJLMGUD",57,0)
D UPD^PSGOEF1 G DONE
"RTN","PSJLMGUD",58,0)
BYPASS ;
"RTN","PSJLMGUD",59,0)
S PSGCANFL=1 G DONE
"RTN","PSJLMGUD",60,0)
;
"RTN","PSJLMGUD",61,0)
EDIT ;
"RTN","PSJLMGUD",62,0)
S PSGPDRG=PSGOPD,PSGPDRGN=PSGOPDN K PSGOEEND D ENF^PSGOEE I PSGCANFL=-1 D
UPD^PSGOEF1
"RTN","PSJLMGUD",63,0)
;
"RTN","PSJLMGUD",64,0)
DONE ;
"RTN","PSJLMGUD",65,0)
K
CHK,DA,DIE,DR,DRG,MSG,ORETURN,ORIFN,PSGEB,PSGEFN,PSGND,PSGOEE,PSGOEEF,PSGOEEND,PSGOE
EG,PSGOEF,PSGOEFF,PSGOES,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGPDRG,PSGDRGN,PSG0XT,PSGS0
Y,OSGSD,Q1,Q2
"RTN","PSJLMGUD",66,0)
K PSGDUR,PSGRMV,PSGRMVT ;*315
"RTN","PSJLMGUD",67,0)
Q
"RTN","PSJLMGUD",68,0)
;
"RTN","PSJLMGUD",69,0)
;
"RTN","PSJLMGUD",70,0)
31 ;;101^PSGOE8;PSGOPD;PSGPD;101;1
"RTN","PSJLMGUD",71,0)
32 ;;109^PSGOE8;PSGODO;PSGDO;102;PSGODO]""
"RTN","PSJLMGUD",72,0)
33 ;;3^PSGOE8;PSGOMR;PSGMR;3;1
"RTN","PSJLMGUD",73,0)
34 ;;7^PSGOE8;PSGOST;PSGST;7;0
"RTN","PSJLMGUD",74,0)
35 ;;26^PSGOE8;PSGOSCH;PSGSCH;26;1
"RTN","PSJLMGUD",75,0)
36 ;;39^PSGOE81;PSGOAT;PSGAT;39;0
"RTN","PSJLMGUD",76,0)
37 ;;1^PSGOE82;PSGOPR;PSGPR;1;1
"RTN","PSJLMGUD",77,0)
38 ;;8^PSGOE81;PSGOSI;PSGSI;8;0
"RTN","PSJLMGUD",78,0)
39 ;;2^PSGOE82;;;2;0
"RTN","PSJLMGUD",79,0)
310 ;;40^PSGOE82;;;40;0
"RTN","PSJLMGUD",80,0)
311 ;;66^PSGOE82;;;66;1
"RTN","PSJLMGUD",81,0)
312 ;;10^PSGOE81;PSGOSD;PSGSD;10;0
"RTN","PSJLMGUD",82,0)
313 ;;25^PSGOE81;PSGOFD;PSGFD;25;0
"RTN","PSJLMGUD",83,0)
314 ;;5^PSGOE82;PSGOSM;PSGSM;5;0
"RTN","PSJLMGUD",84,0)
;
"RTN","PSJLMGUD",85,0)
AH ;
"RTN","PSJLMGUD",86,0)
W !!?2,"Answer 'YES' to accept this order as a NON-VERIFIED UNIT DOSE order. Answer",!,"'NO' to edit
this order now. Enter '^' to BYPASS this order, leaving it as",!,"a PENDING INPATIENT order."
"RTN","PSJLMGUD",87,0)
Q
"RTN","PSJLMPRI")
0^17^B24538481^B24241728
"RTN","PSJLMPRI",1,0)
PSJLMPRI ;BIR/MLM - INPATIENT LISTMAN IV PROFILE UTILITIES ;Jul 05, 2018@13:46
"RTN","PSJLMPRI",2,0)
;;5.0;INPATIENT MEDICATIONS;**58,85,118,110,133,154,181,275,373**;16 DEC 97;Build 3
"RTN","PSJLMPRI",3,0)
;
"RTN","PSJLMPRI",4,0)
; Reference to ^PS(55 is supported by DBIA 2191.
"RTN","PSJLMPRI",5,0)
;
"RTN","PSJLMPRI",6,0)
PIV(DFN,ON,PSJF,DN) ;Setup LM display for IV order.
"RTN","PSJLMPRI",7,0)
N ND14,DRG,ON55,P,PSJORIFN,TYP,V,X,Y,PSJFLAG,ND4 S TYP="?" I ON["V" D
"RTN","PSJLMPRI",8,0)
.S Y=$G(^PS(55,DFN,"IV",+ON,0)) F X=2,3,4,5,8,9,17,23,25 S P(X)=$P(Y,U,X)
"RTN","PSJLMPRI",9,0)
.S TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I TYP'="O" S TYP="C"
"RTN","PSJLMPRI",10,0)
.S ON55=ON,P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I") D GTDRG^PSIVORFB,GTOT^PSIVUTL(P(4))
"RTN","PSJLMPRI",11,0)
.S P("PRY")=$P($G(^PS(55,DFN,"IV",+ON,.2)),U,4),PSJFLAG=$P($G(^(.2)),U,7)
"RTN","PSJLMPRI",12,0)
.S ND4=$G(^PS(55,DFN,"IV",+ON,4)),V=$S(P("PRY")="D":"d",1:" ")_$S((+PSJSYSU=1&'+$P(ND4,U)):"-
>",(+PSJSYSU=3&'+$P(ND4,U,4)):"->",1:"") I PSJFLAG D CNTRL^VALM10(PSJLN,1,4,IORVON,IORVOFF,0)
"RTN","PSJLMPRI",13,0)
.S PSJL=$$SETSTR^VALM1(V,PSJL,6,3)
"RTN","PSJLMPRI",14,0)
.S ND14=$G(^PS(55,DFN,"IV",+ON,14,0)),ND14=$P(ND14,U,3) S:ND14 ND14=+$G(^(ND14,0))
"RTN","PSJLMPRI",15,0)
I ON=+ON N PSJEN2,O S PSJEN2=PSJEN,O="" F S O=$O(^PS(53.1,"ACX",ON,O)) Q:O="" D
"RTN","PSJLMPRI",16,0)
.I PSJEN2'=PSJEN S PSJL=$J(PSJEN2,4)
"RTN","PSJLMPRI",17,0)
.S
(P(2),P(3))="",P(17)=$P($G(^PS(53.1,+O,O)),U,9),Y=+$G(^(8)),P(4)=$P(Y,U),P(8)=$P(Y,U,5),P(9)=$P($G(^(
2)),U),PSJFLAG=$P($G(^(.2)),U,7)
"RTN","PSJLMPRI",18,0)
.D GTDRG^PSIVORFA,GTOT^PSIVUTL(P(4)) D
@$S($E(P("OT"))'="F":"PUD^PSJLMPRU(DFN,O_""P"",PSJF,DN)",1:"PIV^PSJLMPRI(DFN,O_""P"",PSJF,DN)
") S PSJEN2=""
"RTN","PSJLMPRI",19,0)
I ON["P" S
(P(2),P(3))="",P(17)=$P($G(^PS(53.1,+ON,0)),U,9),Y=$G(^(8)),P(4)=$P(Y,U),P(8)=$P(Y,U,5),P(9)=$P($G(^(
2)),U),PSJFLAG=$P($G(^(.2)),U,7) D I $E(P("OT"))'="F" D PUD^PSJLMPRU(DFN,ON,PSJF,DN) Q
"RTN","PSJLMPRI",20,0)
. D GTDRG^PSIVORFA,GTOT^PSIVUTL(P(4))
"RTN","PSJLMPRI",21,0)
. S ND14=$G(^PS(53.1,+ON,14,0)),ND14=$P(ND14,U,3) S:ND14 ND14=+$G(^(ND14,0))
"RTN","PSJLMPRI",22,0)
I $G(PSJFLAG) D CNTRL^VALM10(PSJLN,1,4,IORVON,IORVOFF,0)
"RTN","PSJLMPRI",23,0)
NEW PSJIVFLG S PSJIVFLG=1
"RTN","PSJLMPRI",24,0)
S DRG=+$O(DRG("AD",0)) D:DRG PIVAD F S DRG=$O(DRG("AD",DRG)) Q:'DRG S PSJL="" D PIVAD
"RTN","PSJLMPRI",25,0)
SOL ;
"RTN","PSJLMPRI",26,0)
S PSJL=$S($G(PSJIVFLG):PSJL_$S(ON["V":"in",1:" in"),1:" in")
"RTN","PSJLMPRI",27,0)
NEW DRGX,NAME
"RTN","PSJLMPRI",28,0)
; #373 - Added dot notation (prompted by new call to RENEWDT API) beginning on next line to avoid ln
longer than 245 bytes issue.
"RTN","PSJLMPRI",29,0)
S DRG=0 F S DRG=+$O(DRG("SOL",DRG)) Q:'DRG D
"RTN","PSJLMPRI",30,0)
. D NAME^PSIVUTL(DRG("SOL",DRG),33,.NAME,0)
"RTN","PSJLMPRI",31,0)
. S DRGX=0 F S DRGX=$O(NAME(DRGX)) Q:'DRGX D
"RTN","PSJLMPRI",32,0)
.. S PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,12,33)
"RTN","PSJLMPRI",33,0)
.. D:'$G(PSJIVFLG) RENEWDT D:$G(PSJIVFLG) PIV1
"RTN","PSJLMPRI",34,0)
.. D SETTMP,SETSTAT S PSJL=" "
"RTN","PSJLMPRI",35,0)
;S DRG=0 F S DRG=+$O(DRG("SOL",DRG)) Q:'DRG D NAME^PSIVUTL(DRG("SOL",DRG),39,.NAME,0) S
DRGX=0 F S DRGX=$O(NAME(DRGX)) Q:'DRGX S PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,12,60)
D:'$G(PSJIVFLG) SETTMP D:$G(PSJIVFLG) PIV1 S PSJL=" "
"RTN","PSJLMPRI",36,0)
D RENEWDT I PSJL["Renewed" D SETTMP,SETSTAT ; #373 - in case only one output line, get RENEW
info, if any.
"RTN","PSJLMPRI",37,0)
Q
"RTN","PSJLMPRI",38,0)
PIVAD ; Print IV Additives.
"RTN","PSJLMPRI",39,0)
NEW NAME
"RTN","PSJLMPRI",40,0)
D NAME^PSIVUTL(DRG("AD",DRG),34,.NAME,1) ; #373 - Changed length to 34 from 39
"RTN","PSJLMPRI",41,0)
; #373 - Added calls to RENEWDT API in two lines immediately below.
"RTN","PSJLMPRI",42,0)
I $D(NAME(2)) S PSJL=$$SETSTR^VALM1(NAME(1),PSJL,9,34) D:'$G(PSJIVFLG) RENEWDT D:$G(PSJIVFLG)
PIV1 D SETTMP,SETSTAT S PSJL="",PSJL=$$SETSTR^VALM1(NAME(2),PSJL,9,34) D
RENEWDT,SETTMP,SETSTAT
"RTN","PSJLMPRI",43,0)
I '$D(NAME(2)) S PSJL=$$SETSTR^VALM1(NAME(1),PSJL,9,34) D:'$G(PSJIVFLG) RENEWDT
D:$G(PSJIVFLG) PIV1 D SETTMP,SETSTAT
"RTN","PSJLMPRI",44,0)
Q
"RTN","PSJLMPRI",45,0)
;
"RTN","PSJLMPRI",46,0)
PIV1 ; Print Sched type, start/stop dates, and status.
"RTN","PSJLMPRI",47,0)
;K PSJIVFLG,PSJCLP I $G(PSJCLORD),$G(ON)["P" N PSJCLP S
PSJCLP(2)=$P(^PS(53.1,+ON,2),"^",2),PSJCLP(3)=$P(^PS(53.1,+ON,2),"^",4) F X=2,3 S
PSJCLP(X)=$E($$ENDTC^PSGMI(PSJCLP(X)),1,$S($D(PSJEXTP):8,1:5)) ;#373
"RTN","PSJLMPRI",48,0)
K PSJIVFLG,PSJCLP I $G(PSJCLORD),$G(ON)["P" N PSJCLP S
PSJCLP(2)=$P(^PS(53.1,+ON,2),"^",2),PSJCLP(3)=$P(^PS(53.1,+ON,2),"^",4) F X=2,3 S
PSJCLP(X)=$E($$ENDTC2^PSGMI(PSJCLP(X)),1,$S($D(PSJEXTP):8,1:10)) ;#373
"RTN","PSJLMPRI",49,0)
;F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5)) ;#373
"RTN","PSJLMPRI",50,0)
F X=2,3 S P(X)=$E($$ENDTC2^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:10)) ;#373
"RTN","PSJLMPRI",51,0)
;I '$D(PSJEXTP) S
PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1),PSJL=$$SETSTR^VALM1($S($G(PSJCLP(2)):PSJCLP(2),1:P(2)),PSJL,5
3,7) D ;#373
"RTN","PSJLMPRI",52,0)
;.S
PSJL=$$SETSTR^VALM1($S($G(PSJCLP(3)):PSJCLP(3),1:P(3)),PSJL,60,7),PSJL=$$SETSTR^VALM1($S($G(P(2
5))]"":P(25),1:P(17)),PSJL,66,2) ;#373
"RTN","PSJLMPRI",53,0)
;E S PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1)
"RTN","PSJLMPRI",54,0)
; ,PSJL=$$SETSTR^VALM1($S($G(PSJCLP(2)):PSJCLP(2),1:P(2)),53,7)
"RTN","PSJLMPRI",55,0)
; ,PSJL=$$SETSTR^VALM1($S($G(PSJCLP(3)):PSJCLP(3),1:P(3)),PSJL,63,7)
"RTN","PSJLMPRI",56,0)
; ,PSJL=$$SETSTR^VALM1($S(PSJOL'="L"&($G(P(25))]""):P(25),1:P(17)),PSJL,73,2) ;#373 (line too long
so breaking into dot structure necessary)
"RTN","PSJLMPRI",57,0)
I '$D(PSJEXTP) S
PSJL=$$SETSTR^VALM1(TYP,PSJL,46,1),PSJL=$$SETSTR^VALM1($S($G(PSJCLP(2)):PSJCLP(2),1:P(2)),PSJL,4
9,10) D ;#373
"RTN","PSJLMPRI",58,0)
. S
PSJL=$$SETSTR^VALM1($S($G(PSJCLP(3)):PSJCLP(3),1:P(3)),PSJL,60,10),PSJL=$$SETSTR^VALM1($S($G(P(
25))]"":P(25),1:P(17)),PSJL,71,2) ;#373
"RTN","PSJLMPRI",59,0)
E D ;#373
"RTN","PSJLMPRI",60,0)
. S PSJL=$$SETSTR^VALM1(TYP,PSJL,46,1) ;#373
"RTN","PSJLMPRI",61,0)
. S PSJL=$$SETSTR^VALM1($S($G(PSJCLP(2)):PSJCLP(2),1:P(2)),49,10) ;#373
"RTN","PSJLMPRI",62,0)
. S PSJL=$$SETSTR^VALM1($S($G(PSJCLP(3)):PSJCLP(3),1:P(3)),PSJL,60,10) ;#373
"RTN","PSJLMPRI",63,0)
. S PSJL=$$SETSTR^VALM1($S(PSJOL'="L"&($G(P(25))]""):P(25),1:P(17)),PSJL,71,2) ;#373
"RTN","PSJLMPRI",64,0)
;I $G(ND14) S ND14=$$ENDTC^PSGMI((ND14)) S
PSJL=$$SETSTR^VALM1(ND14,PSJL,$S($D(PSJEXTP):75,1:72),5) K ND14 ;#373
"RTN","PSJLMPRI",65,0)
;* D SETTMP
"RTN","PSJLMPRI",66,0)
Q
"RTN","PSJLMPRI",67,0)
RENEWDT ; 373 - Put renewal date on 2nd line instead of 1st.
"RTN","PSJLMPRI",68,0)
Q:$G(ND14)']"" S PSJL=$$SETSTR^VALM1("Renewed:",PSJL,49,8)
"RTN","PSJLMPRI",69,0)
S ND14=$$ENDTC2^PSGMI((ND14)) S PSJL=$$SETSTR^VALM1(ND14,PSJL,58,10) K ND14
"RTN","PSJLMPRI",70,0)
Q
"RTN","PSJLMPRI",71,0)
;
"RTN","PSJLMPRI",72,0)
SETTMP ;
"RTN","PSJLMPRI",73,0)
S ^TMP($S($G(PSIVLBNM)]"":PSIVLBNM,1:"PSJPRO"),$J,PSJLN,0)=PSJL,PSJLN=PSJLN+1
"RTN","PSJLMPRI",74,0)
Q
"RTN","PSJLMPRI",75,0)
;
"RTN","PSJLMPRI",76,0)
SETSTAT ;
"RTN","PSJLMPRI",77,0)
I ON["P",$P($G(^PS(53.1,+ON,.2)),"^",4)="S" D CNTRL^VALM10((PSJLN-
1),9,9+$L(PSJL),IOINHI_IOBON,IOINORM,0)
"RTN","PSJLMPRI",78,0)
Q
"RTN","PSJLMPRI",79,0)
;
"RTN","PSJLMPRI",80,0)
LASTREN(DFN,ON) ;
"RTN","PSJLMPRI",81,0)
N FIL,RNDT,ND0,ND14 S ND14="" I '$G(ON)!'$G(DFN) Q 0
"RTN","PSJLMPRI",82,0)
S
FIL=$S(ON["P":"^PS(53.1,"_+ON_",14,0)",ON["V":"^PS(55,"_DFN_",""IV"","_+ON_",14,0)",ON["U":"^PS(
55,"_DFN_",5,"_+ON_",14,0)",1:"")
"RTN","PSJLMPRI",83,0)
; Naked reference below refers to either ^PS(53.1,+ON,14,0), ^PS(55,+ON,5,14,0), or
^PS(55,+ON,5,14,0) created using indirection in variable FIL.
"RTN","PSJLMPRI",84,0)
Q:FIL="" 0
"RTN","PSJLMPRI",85,0)
S ND14=$G(@(FIL)) I $P(ND14,"^",3) S ND14=$G(^($P(ND14,"^",3),0))
"RTN","PSJLMPRI",86,0)
Q ND14
"RTN","PSJLMPRI",87,0)
;
"RTN","PSJLMPRI",88,0)
LASTRNBY(DFN,ON) ;
"RTN","PSJLMPRI",89,0)
N FIL,RNBY,ND0,ND14 S RNBY=""
"RTN","PSJLMPRI",90,0)
S
FIL=$S(ON["P":"^PS(53.1,"_+ON_",14,0)",ON["V":"^PS(55,"_DFN_",""IV"","_+ON_",14,0)",ON["U":"^PS(
55,"_DFN_",5,"_+ON_",14,0)",1:"")
"RTN","PSJLMPRI",91,0)
; Naked reference below refers to either ^PS(53.1,+ON,14,0), ^PS(55,+ON,5,14,0), or
^PS(55,+ON,5,14,0) created using indirection in variable FIL.
"RTN","PSJLMPRI",92,0)
Q:FIL="" 0
"RTN","PSJLMPRI",93,0)
S ND14=$G(@(FIL)) I $P(ND14,"^",3) S ND14=$G(^($P(ND14,"^",3),0)),RNBY=$P(ND14,"^",2)
"RTN","PSJLMPRI",94,0)
Q RNBY
"RTN","PSJLMPRU")
0^18^B25811546^B23807055
"RTN","PSJLMPRU",1,0)
PSJLMPRU ;BIR/MLM - INPATIENT LISTMAN UD PROFILE UTILITIES ;Jul 12, 2018@09:55
"RTN","PSJLMPRU",2,0)
;;5.0;INPATIENT MEDICATIONS;**16,58,85,110,185,181,267,323,317,373**;16 DEC 97;Build 3
"RTN","PSJLMPRU",3,0)
;
"RTN","PSJLMPRU",4,0)
; Reference to ^PSDRUG is supported by DBIA 2192.
"RTN","PSJLMPRU",5,0)
; Reference to ^PS(55 is supported by DBIA 2191.
"RTN","PSJLMPRU",6,0)
; Reference to $$GET^XPAR is supported by DBIA 2263
"RTN","PSJLMPRU",7,0)
;
"RTN","PSJLMPRU",8,0)
PUD(DFN,ON,PSJF,DN) ; Setup LM profile view for UD
"RTN","PSJLMPRU",9,0)
N PSJFLAG,PSJV,PADE
"RTN","PSJLMPRU",10,0)
; Naked references on the two lines below refer to full reference ^PS(55,DFN,5,+ON in PSJF using
indirection.
"RTN","PSJLMPRU",11,0)
S
ND=$G(@(PSJF_+ON_",0)")),SCH=$G(^(2)),ND4=$G(^(4)),ND6=$G(^(6)),NDP2=$G(^(.2)),PSJFLAG=$P(ND
P2,U,7),X=$P(DN,U,2),DO=$S('X:"",1:$G(^(+X))) S:X=.2 DO=$P(DO,U,2)
"RTN","PSJLMPRU",12,0)
S ND14=$G(@(PSJF_+ON_",14,0)")),RNDT="" I $P(ND14,"^",3) S
ND14=$G(^($P(ND14,"^",3),0)),RNDT=$P(ND14,"^")
"RTN","PSJLMPRU",13,0)
I ("AO"[PSJC)!(PSJC="DF") D
"RTN","PSJLMPRU",14,0)
.S V='$P(ND4,"^",UDU),PSJL=$$SETSTR^VALM1($S(ND4="":"
",$P(ND4,"^",12):"D",$P(ND4,"^",19)&$P(ND4,"^",18):"H",$P(ND4,"^",23)&$P(ND4,"^",22):"H",$P(ND4,
"^",15)&($P(ND4,"^",16)!V):"R",1:" "),PSJL,5,1)
"RTN","PSJLMPRU",15,0)
.S PSJV=$S($P(NDP2,U,4)="D":"d",1:" ")_$S(+PSJSYSU=1&V:"->",+PSJSYSU=3&V:"->",1:" ") I PSJFLAG D
CNTRL^VALM10(PSJLN,1,4,IORVON,IORVOFF,0)
"RTN","PSJLMPRU",16,0)
.S PSJL=$$SETSTR^VALM1(PSJV,PSJL,6,3)
"RTN","PSJLMPRU",17,0)
S
RTE=$P(ND,"^",3),SM=$S('$P(ND,"^",5):0,$P(ND,"^",6):1,1:2),STAT=$S($P(ND,U,28)]"":$P(ND,U,28),$P(N
D,"^",9)]"":$P(ND,"^",9),1:"NF"),PF=$E("*",$P(ND,"^",20)>0),PSGID=$P(SCH,"^",2),SD=$P(SCH,"^",4),SC
H=$P(SCH,"^")
"RTN","PSJLMPRU",18,0)
I STAT="A",$P(ND,U,27)="R" S STAT="R"
"RTN","PSJLMPRU",19,0)
S NF="",WS=$S(PSJPWD:$$WS^PSJO(PSJPWD,PSGP,PSJF,+ON),1:0)
"RTN","PSJLMPRU",20,0)
I $D(PSJCLIN) S WS=0 ; PSJ*5*323
"RTN","PSJLMPRU",21,0)
; PSJ*5*317 - If PSJ PADE OE BALANCES parameter is YES, PADE balances should display as identifier
"RTN","PSJLMPRU",22,0)
S PADE=0 I $$GET^XPAR("SYS","PSJ PADE OE BALANCES") D
"RTN","PSJLMPRU",23,0)
.N PSJORCL,PSJCLNK
"RTN","PSJLMPRU",24,0)
.; If clinic order, quit if clinic location is not linked to PADE
"RTN","PSJLMPRU",25,0)
.S
PSJORCL=$S($G(ON)["P":$G(^PS(53.1,+$G(ON),"DSS")),$G(ON)["U":$G(^PS(55,+$G(PSGP),5,+$G(ON),8)),
$G(ON)["V":$G(^PS(55,+$G(PSGP),"IV",+$G(ON),"DSS")),1:"")
"RTN","PSJLMPRU",26,0)
.I PSJORCL,$P(PSJORCL,"^",2) S PSJCLNK=$$PADECL^PSJPAD50(+$G(PSJORCL)) Q:'PSJCLNK
"RTN","PSJLMPRU",27,0)
.I '$G(VAIN(4)) N VAIN D INP^VADPT
"RTN","PSJLMPRU",28,0)
.I '$G(PSJCLNK) Q:'$$PADEWD^PSJPAD50(+$G(VAIN(4)))
"RTN","PSJLMPRU",29,0)
.S PADE=$$DRGFLAG^PSJPADSI(PSGP,$G(ON),,$G(ON),$G(PSJNEWOE)) S:PADE=0 PADE=1
"RTN","PSJLMPRU",30,0)
N PSJDISP F PSJDISP=0:0 S PSJDISP=$O(@(PSJF_+ON_",1,"_PSJDISP_")")) Q:'PSJDISP D
"RTN","PSJLMPRU",31,0)
.I $P($G(^PSDRUG(+$P($G(@(PSJF_+ON_",1,"_PSJDISP_",0)")),"^"),0)),"^",9)=1 S NF=1
"RTN","PSJLMPRU",32,0)
;NEW DRUGNAME,PSGID1,SD1,LEN,PSGID1,SD1 S LEN=$S($D(PSJEXPT):8,1:5) ;#373
"RTN","PSJLMPRU",33,0)
;F X="PSGID","SD" S @(X_1)=$S(PSJC["C":"*****",1:$E($$ENDTC^PSGMI(@X),1,LEN)) ;#373
"RTN","PSJLMPRU",34,0)
NEW DRUGNAME,PSGID1,SD1,LEN,PSGID1,SD1 S LEN=$S($D(PSJEXPT):8,1:10) ;#373
"RTN","PSJLMPRU",35,0)
F X="PSGID","SD" S @(X_1)=$S(PSJC["C":"*****",1:$E($$ENDTC2^PSGMI(@X),1,LEN)) ;#373
"RTN","PSJLMPRU",36,0)
;D DRGDISP^PSJLMUT1(PSGP,ON,39,54,.DRUGNAME,0) ;#373
"RTN","PSJLMPRU",37,0)
D DRGDISP^PSJLMUT1(PSGP,ON,33,27,.DRUGNAME,0) ;#373
"RTN","PSJLMPRU",38,0)
S RNDTPRT=0 ;#373
"RTN","PSJLMPRU",39,0)
F PSJX=0:0 S PSJX=$O(DRUGNAME(PSJX)) Q:'PSJX D
"RTN","PSJLMPRU",40,0)
.I PSJX=1 D
"RTN","PSJLMPRU",41,0)
..I PSJFLAG D CNTRL^VALM10(PSJLN,1,4,IORVON,IORVOFF,0)
"RTN","PSJLMPRU",42,0)
..S PSJL=$$SETSTR^VALM1($S($E(PSJS)="*":$P(PSJS,"^"),1:DRUGNAME(PSJX)),PSJL,9,39)
"RTN","PSJLMPRU",43,0)
..S PSJL=$$SETSTR^VALM1($S(PSJC["C":"?",PSJSCHT'="z":PSJSCHT,1:"?"),PSJL,46,3) ;#373
"RTN","PSJLMPRU",44,0)
..;S PSJL=PSJL_PSGID1_" "_SD1_" "_$E(STAT,1,2)_$S($L(STAT)=1:" ",1:"
")_$S($G(RNDT):$E($$ENDTC^PSGMI(RNDT),1,LEN),1:"") ;#373
"RTN","PSJLMPRU",45,0)
..S PSJL=$$SETSTR^VALM1(PSGID1,PSJL,49,10),PSJL=$$SETSTR^VALM1(SD1,PSJL,60,10) ;#373
"RTN","PSJLMPRU",46,0)
..S PSJL=$$SETSTR^VALM1($E(STAT,1,2)_$S($L(STAT)=1:" ",1:""),PSJL,71,2) ;#373
"RTN","PSJLMPRU",47,0)
..;S PSJL=PSJL_PSGID1_" "_SD1_" "_$E(STAT,1,2)_$S($L(STAT)=1:" ",1:" ")
"RTN","PSJLMPRU",48,0)
..;I NF!WS!SM!PF!$G(PADE) S PSJL=$$SETSTR^VALM1($S(NF:"NF ",(WS&PADE):"WP ",(PADE&'WS):"PD
",WS:"WS ",SM:$E("HSM",SM,3),1:""),PSJL,69,3) S:PF PSJL=$$SETSTR^VALM1("*",PSJL,79,1) ;#373
"RTN","PSJLMPRU",49,0)
..I NF!WS!SM!PF!$G(PADE) S PSJL=$$SETSTR^VALM1($S(NF:"NF ",(WS&PADE):"WP ",(PADE&'WS):"PD
",WS:"WS ",SM:$E("HSM",SM,3),1:""),PSJL,74,3) S:PF PSJL=$$SETSTR^VALM1("*",PSJL,78,1) ;#373
"RTN","PSJLMPRU",50,0)
. I PSJX>1 S PSJL="",PSJL=$$SETSTR^VALM1(DRUGNAME(PSJX),PSJL,11,33)
"RTN","PSJLMPRU",51,0)
. I PSJX=2 D RNDTDSP ;#373 - Renewal Date logic added for Unit Dose
"RTN","PSJLMPRU",52,0)
. ;I PSJX>1 S PSJL="",PSJL=$$SETSTR^VALM1(DRUGNAME(PSJX),PSJL,11,66) ; #373
"RTN","PSJLMPRU",53,0)
. D SETTMP("PSJPRO",PSJL) I ($P(NDP2,U,4)="S"),STAT="P" D CNTRL^VALM10((PSJLN-
1),9,9+$L(PSJL),IOINHI_IOBON,IOINORM,0)
"RTN","PSJLMPRU",54,0)
I 'RNDTPRT S PSJL="" D RNDTDSP D:RNDTPRT SETTMP("PSJPRO",PSJL) ;#373
"RTN","PSJLMPRU",55,0)
I ND6'="" N X,PSJTXT3 S X=$$GETSIOPI^PSJBCMA5(DFN,ON) N TXTLN S TXTLN=0 F S
TXTLN=$O(^PS(53.45,DUZ,5,TXTLN)) Q:'TXTLN!$G(PSJTXT3) D
"RTN","PSJLMPRU",56,0)
.I ($O(^PS(53.45,DUZ,5," "),-1)>3) S PSJTXT3=1 S PSJL="Instructions too long. See Order View for full
text." D PTXT(PSJL,"PSJPRO",10,66) Q
"RTN","PSJLMPRU",57,0)
.S PSJL=^PS(53.45,DUZ,5,TXTLN,0) D PTXT(PSJL,"PSJPRO",10,66)
"RTN","PSJLMPRU",58,0)
K RNDTPRT ;#373
"RTN","PSJLMPRU",59,0)
K ^PS(53.45,DUZ,5)
"RTN","PSJLMPRU",60,0)
Q
"RTN","PSJLMPRU",61,0)
;
"RTN","PSJLMPRU",62,0)
RNDTDSP ; Display Renewal Date - #373
"RTN","PSJLMPRU",63,0)
NEW RNDTDSP S RNDTDSP=$S($G(RNDT):$E($$ENDTC2^PSGMI(RNDT),1,LEN),1:"")
"RTN","PSJLMPRU",64,0)
I RNDTDSP]"" D
"RTN","PSJLMPRU",65,0)
. S PSJL=$$SETSTR^VALM1("Renewed:",PSJL,49,8)
"RTN","PSJLMPRU",66,0)
. S PSJL=$$SETSTR^VALM1(RNDTDSP,PSJL,58,10)
"RTN","PSJLMPRU",67,0)
. S RNDTPRT=1
"RTN","PSJLMPRU",68,0)
Q
"RTN","PSJLMPRU",69,0)
;
"RTN","PSJLMPRU",70,0)
PTXT(TXT,SUB,LM,RM) ; Display Instructions/dosage ordered.
"RTN","PSJLMPRU",71,0)
;* Input: TXT = Text to display.
"RTN","PSJLMPRU",72,0)
; SUB = First subscript for ^TMP node, ** MUST be PSJ namespace **
"RTN","PSJLMPRU",73,0)
; LM = Begin display of text after LM spaces.
"RTN","PSJLMPRU",74,0)
; RM = Length of display text.
"RTN","PSJLMPRU",75,0)
;
"RTN","PSJLMPRU",76,0)
;BHW;PSJ*5*185;Extra spaces causes display to "skip" part of the field.
"RTN","PSJLMPRU",77,0)
;S PSJL="",$P(PSJL," ",LM)="" F X=1:1 S WRD=$P(TXT," ",X) Q:WRD="" D
"RTN","PSJLMPRU",78,0)
S PSJL="",$P(PSJL," ",LM)=""
"RTN","PSJLMPRU",79,0)
F X=1:1:$L(TXT," ") S WRD=$P(TXT," ",X) D
"RTN","PSJLMPRU",80,0)
.;BHW;PSJ*5*185;check if end of string or just extra space
"RTN","PSJLMPRU",81,0)
.I WRD="" S PSJL=PSJL_" " Q
"RTN","PSJLMPRU",82,0)
.I $L(PSJL_" "_WRD)'<RM D SETTMP(SUB,PSJL) S PSJL="",$P(PSJL," ",10)=""
"RTN","PSJLMPRU",83,0)
.I $L(PSJL_" "_WRD)'<RM S PSJL=PSJL_" "_$E(WRD,1,(RM-10)) D SETTMP(SUB,PSJL) S PSJL="",$P(PSJL,"
",10)="",WRD=$E(WRD,(RM-9),$L(WRD))
"RTN","PSJLMPRU",84,0)
.S PSJL=PSJL_" "_WRD
"RTN","PSJLMPRU",85,0)
D SETTMP(SUB,PSJL)
"RTN","PSJLMPRU",86,0)
Q
"RTN","PSJLMPRU",87,0)
SETTMP(SUB,PSJL) ;
"RTN","PSJLMPRU",88,0)
S ^TMP(SUB,$J,PSJLN,0)=PSJL,PSJLN=PSJLN+1
"RTN","PSJLMPRU",89,0)
Q
"RTN","PSJLMUDE")
0^19^B97320744^B97062795
"RTN","PSJLMUDE",1,0)
PSJLMUDE ;BIR/MLM - SHOW FIELDS FOR EDIT (LISTMAN STYLE) ;Jul 06, 2018@08:26
"RTN","PSJLMUDE",2,0)
;;5.0;INPATIENT
MEDICATIONS;**7,47,50,63,64,58,80,116,110,111,164,175,201,181,254,267,228,315,317,338,373**;16
DEC 97;Build 3
"RTN","PSJLMUDE",3,0)
;
"RTN","PSJLMUDE",4,0)
;NFI-UD Fr#:2 chgs@init+4 to display non-formulary (N/F)
"RTN","PSJLMUDE",5,0)
;also chgs @init+23
"RTN","PSJLMUDE",6,0)
;
"RTN","PSJLMUDE",7,0)
; Reference to ^PS(55 is supported by DBIA# 2191
"RTN","PSJLMUDE",8,0)
; Reference to ^PSDRUG is supported by DBIA 2192
"RTN","PSJLMUDE",9,0)
; Reference to $$GET^XPAR is supported by DBIA #2263
"RTN","PSJLMUDE",10,0)
;
"RTN","PSJLMUDE",11,0)
INIT(PSGP,PSGORD) ;
"RTN","PSJLMUDE",12,0)
N D,ND,PSJBCMA,PSJL,PSJLM,PSJLN,Q,QQ,PSJDUR,J K ^TMP("PSJUDE",$J),^TMP($J,"GMRAING")
"RTN","PSJLMUDE",13,0)
K:$G(PSJNORD) PSGOEEF S PSJLN=1
"RTN","PSJLMUDE",14,0)
D CLEAN^VALM10
"RTN","PSJLMUDE",15,0)
S PSJL=$S($D(PSGEFN(1)):$E(" *",PSGEFN(1)+1)_"(1)",1:" "),PSJL=$$SETSTR^VALM1("Orderable Item:
"_PSGPDN_$$OINF^PSJDIN(PSGPD),PSJL,5,74) D D SETTMP D:$G(PSGOEEF(108))!($G(PSGOEEF(101)))
HILITE(1)
"RTN","PSJLMUDE",16,0)
. NEW Q,PSJDDA,PSJVD F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q S PSJDDA(+$G(^(Q,0)))=""
"RTN","PSJLMUDE",17,0)
. S PSJVD=$$DINFLUD^PSJDIN(PSGPD,.PSJDDA)
"RTN","PSJLMUDE",18,0)
. I $$OVRCHK^PSGSICH1(PSGP,PSGORD) S PSJVD="<OCI>"_PSJVD
"RTN","PSJLMUDE",19,0)
. S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,(80-$L(PSJVD)),80)
"RTN","PSJLMUDE",20,0)
. D:PSJVD]"" CNTRL^VALM10(1,80-$L(PSJVD),$L(PSJVD),IORVON,IORVOFF,0)
"RTN","PSJLMUDE",21,0)
I $G(PSJORD)["P" D REQDT^PSJLIVMD(PSJORD)
"RTN","PSJLMUDE",22,0)
S PSJL="Instructions: "_PSGOINST D PTXT^PSJLMPRU(PSJL,"PSJUDE",6,80)
"RTN","PSJLMUDE",23,0)
S PSJL=$S($D(PSGEFN(2)):$E(" *",PSGEFN(2)+1)_"(2)",1:" "),PSJL=$$SETSTR^VALM1("Dosage Ordered:
"_PSGDO,PSJL,5,76) D SETTMP D:$G(PSGOEEF(109)) HILITE(2)
"RTN","PSJLMUDE",24,0)
I $G(PSGRDTX) S PSJDUR=$$FMTDUR^PSJLIVMD($P($G(PSGRDTX),U,2))
"RTN","PSJLMUDE",25,0)
I $G(PSJORD),($G(PSJDUR)="") S P=$S(PSJORD["U":5,PSJORD["V":"IV",PSJORD["P":"P",1:-1) S
PSJDUR=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,P)
"RTN","PSJLMUDE",26,0)
S PSJL=$$SETSTR^VALM1("Duration: "_$G(PSJDUR),PSJL,11,25)
"RTN","PSJLMUDE",27,0)
;S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:" ")_"Start:
"_$P(PSGSDN,U,2),PSJL,54,26) D:$G(PSGOEEF(10)) HILITE(3) ;#373
"RTN","PSJLMUDE",28,0)
S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:" ")_"Start:
"_$P(PSGSDN,U,2),PSJL,52,28) D:$G(PSGOEEF(10)) HILITE(3) ;#373
"RTN","PSJLMUDE",29,0)
I $G(PSGORD)["P" N ND0,OLDO S ND0=@(PSGOEEWF_"0)") I $P(ND0,"^",24)="R" S
OLDO=$P(ND0,"^",25) I OLDO,(OLDO["U") D
"RTN","PSJLMUDE",30,0)
. ;N OSTRT,OSTRTN S OSTRT=$G(@("^PS(55,"_PSGP_",5,"_+OLDO_",2)")),OSTRT=$P(OSTRT,"^",2)
Q:'OSTRT S OSTRTN=$$ENDTC^PSGMI(+OSTRT) ;#373
"RTN","PSJLMUDE",31,0)
. N OSTRT,OSTRTN S OSTRT=$G(@("^PS(55,"_PSGP_",5,"_+OLDO_",2)")),OSTRT=$P(OSTRT,"^",2)
Q:'OSTRT S OSTRTN=$$ENDTC2^PSGMI(+OSTRT) ;#373
"RTN","PSJLMUDE",32,0)
. ;S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:" ")_"Start:
"_OSTRTN,PSJL,54,26) ;#373
"RTN","PSJLMUDE",33,0)
. S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:" ")_"Start:
"_OSTRTN,PSJL,52,28) ;#373
"RTN","PSJLMUDE",34,0)
D SETTMP
"RTN","PSJLMUDE",35,0)
S PSJL=$S($D(PSGEFN(4)):$E(" *",PSGEFN(4)+1)_"(4)",1:" "),PSJL=$$SETSTR^VALM1("Med Route:
"_PSGMRN,PSJL,10,35) D:$G(PSGOEEF(3)) HILITE(4)
"RTN","PSJLMUDE",36,0)
;I $G(PSJORD)["P" N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,PSGORD) S:PSGRNDT
PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,56,32)
;#373
"RTN","PSJLMUDE",37,0)
I $G(PSJORD)["P" N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,PSGORD) S:PSGRNDT
PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32)
;#373
"RTN","PSJLMUDE",38,0)
I '$G(PSGRNDT),$G(PSGRDTX) D
"RTN","PSJLMUDE",39,0)
. ;I $D(PSGRDTX)<10 S PSGRSDN=$$ENDTC^PSGMI(+PSGRDTX),PSJL=$$SETSTR^VALM1("REQUESTED
START: "_PSGRSDN,PSJL,48,32) Q ;#373
"RTN","PSJLMUDE",40,0)
. I $D(PSGRDTX)<10 S PSGRSDN=$$ENDTC2^PSGMI(+PSGRDTX),PSJL=$$SETSTR^VALM1("REQUESTED
START: "_PSGRSDN,PSJL,46,34) Q ;#373
"RTN","PSJLMUDE",41,0)
. ;I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$P($G(PSGSDN),U,2) S
PSGRSDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRSD")),PSJL=$$SETSTR^VALM1("Calc Start:
"_PSGRSDN,PSJL,53,32) D ;#373
"RTN","PSJLMUDE",42,0)
. I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$P($G(PSGSDN),U,2) S
PSGRSDN=$$ENDTC2^PSGMI(PSGRDTX(+PSJORD,"PSGRSD")),PSJL=$$SETSTR^VALM1("Calc Start:
"_PSGRSDN,PSJL,51,34) D ;#373
"RTN","PSJLMUDE",43,0)
.. I PSGSD'=PSGRDTX(+PSJORD,"PSGRSD") D CNTRL^VALM10(5,53,80,IORVON,IORVOFF)
"RTN","PSJLMUDE",44,0)
; Indirect reference in PSGOEEWF below refers to either ^PS(53.1 or ^PS(55,DFN,5,. Naked reference
refers to full indirect reference
"RTN","PSJLMUDE",45,0)
I $G(PSJORD)["U" N ND14 S ND14=$G(@(PSGOEEWF_"14,0)")) I ND14]"" S
ND14=$G(^($P(ND14,"^",3),0)),RNDT=$P(ND14,"^") I RNDT D
"RTN","PSJLMUDE",46,0)
. ;N PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+RNDT),PSJL=$$SETSTR^VALM1("Renewed:
"_PSGRNDT,PSJL,56,32) ;#373
"RTN","PSJLMUDE",47,0)
. N PSGRNDT S PSGRNDT=$$ENDTC2^PSGMI(+RNDT),PSJL=$$SETSTR^VALM1("Renewed:
"_PSGRNDT,PSJL,54,34) ;#373
"RTN","PSJLMUDE",48,0)
D SETTMP
"RTN","PSJLMUDE",49,0)
I PSGORD]"" S PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSGORD)
"RTN","PSJLMUDE",50,0)
I $G(PSJBCMA)]"" S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
"RTN","PSJLMUDE",51,0)
;S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(5)):$E(" *",PSGEFN(5)+1)_"(5)",1:" ")_" Stop:
"_$P(PSGFDN,U,2),PSJL,54,26) D SETTMP D:$G(PSGOEEF(25))!($G(PSGOEEF(34))) HILITE(5) ;#373
"RTN","PSJLMUDE",52,0)
S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(5)):$E(" *",PSGEFN(5)+1)_"(5)",1:" ")_" Stop:
"_$P(PSGFDN,U,2),PSJL,52,28) D SETTMP D:$G(PSGOEEF(25))!($G(PSGOEEF(34))) HILITE(5) ;#373
"RTN","PSJLMUDE",53,0)
S PSJL=$S($D(PSGEFN(6)):$E(" *",PSGEFN(6)+1)_"(6)",1:" "),PSJL=$$SETSTR^VALM1("Schedule Type:
"_PSGSTN,PSJL,6,45) D:$G(PSGOEEF(7)) HILITE(6)
"RTN","PSJLMUDE",54,0)
;I $G(PSJORD)["P",$G(PSGRDTX(+$G(PSJORD),"PSGRFD")),$P($G(PSGFDN),U,2) S
PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD")),PSJL=$$SETSTR^VALM1("Calc Stop:
"_PSGRFDN,PSJL,54,26) D ;#373
"RTN","PSJLMUDE",55,0)
I $G(PSJORD)["P",$G(PSGRDTX(+$G(PSJORD),"PSGRFD")),$P($G(PSGFDN),U,2) S
PSGRFDN=$$ENDTC2^PSGMI(PSGRDTX(+PSJORD,"PSGRFD")),PSJL=$$SETSTR^VALM1("Calc Stop:
"_PSGRFDN,PSJL,52,28) D ;#373
"RTN","PSJLMUDE",56,0)
. I PSGFD'=PSGRDTX(+PSJORD,"PSGRFD") D CNTRL^VALM10(7,54,80,IORVON,IORVOFF)
"RTN","PSJLMUDE",57,0)
D SETTMP
"RTN","PSJLMUDE",58,0)
S PSGSMN=$P("NO^YES",U,PSGSM+1)
"RTN","PSJLMUDE",59,0)
S PSJL=$S($D(PSGEFN(8)):$E(" *",PSGEFN(8)+1)_"(8)",1:" "),PSJL=$$SETSTR^VALM1("Schedule:
"_PSGSCH_$G(SCHMSG),PSJL,11,68) D SETTMP D:$G(PSGOEEF(26)) HILITE(8)
"RTN","PSJLMUDE",60,0)
S PSJL=$S($D(PSGEFN(9)):$E(" *",PSGEFN(9)+1)_"(9)",1:" "),PSJL=$$SETSTR^VALM1("Admin Times:
"_PSGAT,PSJL,8,71) D SETTMP D:'$G(PSGNOHI)&($G(PSGOEEF(39))!($G(PSGOEEF(41)))) HILITE(9) ;*315
"RTN","PSJLMUDE",61,0)
I +$G(PSGRF)>1 N PSGRMVD S PSGRMVD=$S(+$G(PSGRMVT):PSGRMVT,1:"") S
PSJL=$$SETSTR^VALM1("Removal Times: "_PSGRMVD,PSJL,6,71) D SETTMP ;*315
"RTN","PSJLMUDE",62,0)
S PSJL=$S($D(PSGEFN(10)):$E(" *",PSGEFN(10)+1)_"(10)",1:" "),PSJL=$$SETSTR^VALM1("Provider:
"_PSGPRN,PSJL,11,68) D:$G(PSGOEEF(1)) HILITE(10) D SETTMP
"RTN","PSJLMUDE",63,0)
S PSJL=$S($D(PSGEFN(11)):$E(" *",PSGEFN(11))_" (11)",1:" ")_" Special
Instructions"_$S($P(PSGSI,"^",2)=1:"!: ",1:": ") D
"RTN","PSJLMUDE",64,0)
.I '$D(^PS(53.45,DUZ,5,1)),$G(PSGORD) D GETSI^PSJBCMA5(PSGP,PSGORD)
"RTN","PSJLMUDE",65,0)
.I '$P($G(^PS(53.45,DUZ,5,0)),"^",3) S PSJL=PSJL_$P($G(PSGSI),"^") D
PTXT^PSJLMPRU(PSJL,"PSJUDE",1,80) Q
"RTN","PSJLMUDE",66,0)
.S PSJL=PSJL_" (see below)" D SETTMP N I S I=0 F J=1:1 S I=$O(^PS(53.45,DUZ,5,I)) Q:'I S PSJL="
"_^PS(53.45,DUZ,5,I,0) D SETTMP
"RTN","PSJLMUDE",67,0)
S PSJL="" D SETTMP D:$G(PSGOEEF(8)) HILITE(11)
"RTN","PSJLMUDE",68,0)
; E3R 16130
"RTN","PSJLMUDE",69,0)
I $O(^PS(53.45,PSJSYSP,2,1)) F S PSJL="" D SETTMP Q:PSJLN>15
"RTN","PSJLMUDE",70,0)
S PSJL=$S($D(PSGEFN(12)):$E(" *",PSGEFN(12))_" (12)",1:" ")_" Dispense
Drug",PSJL=$$SETSTR^VALM1("U/D",PSJL,52,60),PSJL=$$SETSTR^VALM1("Inactive Date",PSJL,59,16) D
D SETTMP,CNTRL^VALM10(PSJLN-1,1,80,IOUON,IOUOFF,0)
"RTN","PSJLMUDE",71,0)
.I $$GET^XPAR("SYS","PSJ PADE OE BALANCES") D
"RTN","PSJLMUDE",72,0)
..I '$G(VAIN(4)) N VAIN,DFN S DFN=$G(PSGP) D INP^VADPT
"RTN","PSJLMUDE",73,0)
..N PSJORCL,PSJCLNK
"RTN","PSJLMUDE",74,0)
..; If clinic order, quit if clinic location is not linked to PADE
"RTN","PSJLMUDE",75,0)
..S
PSJORCL=$S($G(PSGORD)["P":$G(^PS(53.1,+$G(PSGORD),"DSS")),$G(PSGORD)["U":$G(^PS(55,+$G(PSGP
),5,+$G(PSGORD),8)),$G(PSGORD)["V":$G(^PS(55,+$G(PSGP),"IV",+$G(PSGORD),"DSS")),1:"")
"RTN","PSJLMUDE",76,0)
..I PSJORCL,$P(PSJORCL,"^",2) S PSJCLNK=$$PADECL^PSJPAD50(+$G(PSJORCL)) Q:'PSJCLNK
"RTN","PSJLMUDE",77,0)
..I '$G(PSJCLNK) Q:'$$PADEWD^PSJPAD50(+$G(VAIN(4))) ; PADE device Inactive?
"RTN","PSJLMUDE",78,0)
..S PSJL=$$SETSTR^VALM1("PADE",PSJL,75,5)
"RTN","PSJLMUDE",79,0)
NEW PSJX,PSJDLINE
"RTN","PSJLMUDE",80,0)
F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q S ND=$G(^(Q,0)) D
"RTN","PSJLMUDE",81,0)
.S D=$P(ND,"^"),PSGID=$P(ND,"^",3) I PSGID S PSGID=$$ENDTC^PSGMI(PSGID)
"RTN","PSJLMUDE",82,0)
.S D=$S(D="":"NOT FOUND",'$D(^PSDRUG(D,0)):D,$P(^(0),"^")]"":$P(^(0),"^"),1:D_";PSDRUG(")
"RTN","PSJLMUDE",83,0)
.S PSJL="
"_D_$$DDNF^PSJDIN(+ND),PSJL=$$SETSTR^VALM1($S($P(ND,"^",2):$S($P(ND,"^",2)=.5:"1/2",$P(ND,"^"
,2)=.25:"1/4",1:$P(ND,"^",2)),$P(ND,"^",2)=0:0,1:1),PSJL,52,63) S:PSGID
PSJL=$$SETSTR^VALM1(PSGID,PSJL,59,16) D D SETTMP
"RTN","PSJLMUDE",84,0)
..; PSJ*5*317 - If PSJ PADE OE BALANCES parameter is YES, PADE balances should display as identifier.
"RTN","PSJLMUDE",85,0)
..I $$GET^XPAR("SYS","PSJ PADE OE BALANCES") D
"RTN","PSJLMUDE",86,0)
...N PSJPDLOC,VAIN,PSJORCL,PSJCLNK,PSJCLND D INP^VADPT
"RTN","PSJLMUDE",87,0)
...; If clinic order, quit if clinic location is not linked to PADE
"RTN","PSJLMUDE",88,0)
...S
PSJCLND=$S($G(PSGORD)["P":$G(^PS(53.1,+$G(PSGORD),"DSS")),$G(PSGORD)["U":$G(^PS(55,+$G(PSGP
),5,+$G(PSGORD),8)),$G(PSGORD)["V":$G(^PS(55,+$G(PSGP),"IV",+$G(PSGORD),"DSS")),1:"")
"RTN","PSJLMUDE",89,0)
...S PSJORCL=$S(+PSJCLND&$P(PSJCLND,"^",2):+PSJCLND,1:"")
"RTN","PSJLMUDE",90,0)
...I PSJORCL,$P(PSJCLND,"^",2) S PSJCLNK=$$PADECL^PSJPAD50(+$G(PSJORCL)) Q:'PSJCLNK
"RTN","PSJLMUDE",91,0)
...I '$G(PSJCLNK) Q:'$$PADEWD^PSJPAD50(+$G(VAIN(4))) ; Quit if patient location not linked to PADE
"RTN","PSJLMUDE",92,0)
...S PSJPDLOC=$S($G(PSJCLNK):PSJORCL_"C",1:"")
"RTN","PSJLMUDE",93,0)
...S:'PSJPDLOC PSJPDLOC=+$G(VAIN(4))
"RTN","PSJLMUDE",94,0)
...N PADE S PADE=$J($$DRGQTY^PSJPADSI(+ND,$S(PSJPDLOC["C":"CL",1:"WD"),+PSJPDLOC),5)
"RTN","PSJLMUDE",95,0)
...S PSJL=$$SETSTR^VALM1(PADE,PSJL,74,5)
"RTN","PSJLMUDE",96,0)
..S PSJX=$G(PSJX)+1
"RTN","PSJLMUDE",97,0)
..S PSJDLINE=$S($P(^PS(53.45,PSJSYSP,2,0),U,3)>1:16,1:13) ;*228 - Highlight multiple dispense drugs
"RTN","PSJLMUDE",98,0)
..I $G(PSGOEEF(109)) D CNTRL^VALM10(PSJDLINE+PSJX,7,73,IORVON_IOBON,IORVOFF_IOBOFF,0)
"RTN","PSJLMUDE",99,0)
I $S(PSGORD["P":$O(^PS(53.1,+$G(PSGORD),12,0)),1:$O(^PS(55,PSGP,5,+PSGORD,12,0))) S
PSJL="Provider Comments:" D SETTMP S PSJL="" D
"RTN","PSJLMUDE",100,0)
.F Q=0:0 S Q=$S(PSGORD["P":$O(^PS(53.1,+$G(PSGORD),12,Q)),1:$O(^PS(55,PSGP,5,+PSGORD,12,Q)))
Q:'Q S PSJL=$G(^(Q,0)) D SETTMP
"RTN","PSJLMUDE",101,0)
D SETTMP S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:" ")_"Self Med:
"_PSGSMN,PSJL,1,24)
"RTN","PSJLMUDE",102,0)
S:PSGSM&PSGHSM PSJL=$$SETSTR^VALM1(" (HS)",PSJL,16,7) D SETTMP D:$G(PSGOEEF(5)) HILITE(7)
"RTN","PSJLMUDE",103,0)
D SETTMP S PSJL="Entry By: "_PSGEBN,PSJL=$$SETSTR^VALM1("Entry Date:
"_$P(PSGLIN,U,2),PSJL,51,39) D SETTMP
"RTN","PSJLMUDE",104,0)
I $G(PSGLRN) D SETTMP S PSJL="Renewed By: "_$$ENNPN^PSGMI($P(PSGLRN,"^",2)) D SETTMP
"RTN","PSJLMUDE",105,0)
D SETTMP S PSJL="(13)"_" Comments:"
"RTN","PSJLMUDE",106,0)
D:'$O(^PS(53.45,PSJSYSP,1,0)) SETTMP
"RTN","PSJLMUDE",107,0)
D SETTMP F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,1,Q)) Q:'Q S PSJWPL=PSJL_$S($E(PSJL)=" ":"",1:"
")_$G(^(Q,0)),PSJL="" D DISPLAY
"RTN","PSJLMUDE",108,0)
D SETTMP
"RTN","PSJLMUDE",109,0)
I PSGORD["P",($P($G(^PS(53.1,+PSGORD,0)),U,9)="P"),$O(^PS(53.1,+PSGORD,10,0)) D
"RTN","PSJLMUDE",110,0)
.D SETTMP S PSJL="CPRS Order Checks:" D SETTMP
"RTN","PSJLMUDE",111,0)
.F Q=0:0 S Q=$O(^PS(53.1,+PSGORD,10,Q)) Q:'Q D
"RTN","PSJLMUDE",112,0)
..;S PSJL="" D SETTMP S PSJL=$G(^PS(53.1,+PSGORD,10,Q,0)) D SETTMP
"RTN","PSJLMUDE",113,0)
..S PSJL="" D SETTMP
"RTN","PSJLMUDE",114,0)
..D FORMATTX($G(^PS(53.1,+PSGORD,10,Q,0)))
"RTN","PSJLMUDE",115,0)
..S PSJL="Overriding Provider: "_$P($G(^PS(53.1,+PSGORD,10,Q,1)),U) D SETTMP
"RTN","PSJLMUDE",116,0)
..S PSJL="Overriding Reason: " F X=0:0 S X=$O(^PS(53.1,+PSGORD,10,Q,2,X)) Q:'X D
"RTN","PSJLMUDE",117,0)
...S PSJL=PSJL_$G(^PS(53.1,+PSGORD,10,Q,2,X,0)) D SETTMP S PSJL=" "
"RTN","PSJLMUDE",118,0)
ACTFLG ;
"RTN","PSJLMUDE",119,0)
S ND4=$S(PSGORD["P":$G(^PS(53.1,+PSGORD,4)),1:$G(^PS(55,PSGP,5,+PSGORD,4)))
"RTN","PSJLMUDE",120,0)
S AT="",Y="12,13,D,18,19,H1,22,23,H0,15,16,R" F X=1:3:12 I
$P(ND4,"^",$P(Y,",",X)),$P(ND4,"^",$P(Y,",",X+1)) S AT=$P(Y,",",X+2) Q
"RTN","PSJLMUDE",121,0)
I AT="",'$P(ND4,"^",$S($P(PSJSYSU,";",3)>1:3,1:1)) S
AT="V"_$S($P(ND4,"^",18):"H1",$P(ND4,"^",22):"H0",$P(ND4,"^",15):"R",1:"")
"RTN","PSJLMUDE",122,0)
I AT]"" D
"RTN","PSJLMUDE",123,0)
.S PSJL="" D SETTMP
"RTN","PSJLMUDE",124,0)
.S PSJL="ORDER "_$S(AT["V":"NOT VERIFIED"_$S($P(AT,"V",2)="":"",1:" ("_$S(AT["H1":"ON
HOLD",AT["H0":"OFF HOLD",1:"RENEWAL")_")"),1:"MARKED TO BE
"_$S(AT["D":"CANCELLED",AT["H1":"PLACED ON HOLD",AT["H0":"TAKEN OFF OF HOLD",1:"RENEWED"))
"RTN","PSJLMUDE",125,0)
I AT'["V",AT["H1",$D(^PS(55,PSGP,5.1)) S AT=^(5.1) I $P(AT,"^",7),$P(AT,"^",10)]"" S PSJL=PSJL_"
("_$P(AT,"^",10)_")"
"RTN","PSJLMUDE",126,0)
D SETTMP
"RTN","PSJLMUDE",127,0)
S VALMCNT=PSJLN-1
"RTN","PSJLMUDE",128,0)
K PSGSMN,Q,Y,Y1,Y2,PSGLRN
"RTN","PSJLMUDE",129,0)
S VALM("TITLE")=PSGSTAT_" UNIT DOSE
"_$S((PSGSTAT="PENDING")&($G(PSGPRIO)]""):"("_PSGPRIO_")",$G(PSGPRIO)="DONE":"("_PSGPRIO_")
",1:"") I $D(PSJLMP2) S VALMBG=16 K PSJLMP2
"RTN","PSJLMUDE",130,0)
TEST ;
"RTN","PSJLMUDE",131,0)
I $G(PSGPFLG) S VALMSG="INVALID ORDERABLE ITEM"
"RTN","PSJLMUDE",132,0)
I $G(PSGDI) S VALMSG=$S($G(VALMSG)="":"INVALID",1:VALMSG_",")_" DISPENSE DRUG"
"RTN","PSJLMUDE",133,0)
I $G(PSGPI) S VALMSG=$S($G(VALMSG)="":"INVALID",1:VALMSG_",")_" PROVIDER"
"RTN","PSJLMUDE",134,0)
I $G(PSGDREQ) S CHK=1,VALMSG="DOSAGE IS REQUIRED" K PSGDREQ
"RTN","PSJLMUDE",135,0)
Q
"RTN","PSJLMUDE",136,0)
DISPLAY ;
"RTN","PSJLMUDE",137,0)
S PSJL=PSJWPL D SETTMP
"RTN","PSJLMUDE",138,0)
Q
"RTN","PSJLMUDE",139,0)
;
"RTN","PSJLMUDE",140,0)
SETTMP ;
"RTN","PSJLMUDE",141,0)
S ^TMP("PSJUDE",$J,PSJLN,0)=PSJL,PSJLN=PSJLN+1,PSJL=""
"RTN","PSJLMUDE",142,0)
Q
"RTN","PSJLMUDE",143,0)
;
"RTN","PSJLMUDE",144,0)
HILITE(FLD) ;
"RTN","PSJLMUDE",145,0)
N COL,LIN,WID,X
"RTN","PSJLMUDE",146,0)
S
X="$T("_FLD_"^PSJLMUDE)",@("X="_X),X=$P(X,";;",2),LIN=+X,COL=$P(X,",",2),LAB=$P(X,",",3),X=$P(X,","
,4),WID=(LAB+$L(@X))
"RTN","PSJLMUDE",147,0)
I $G(PSGRF),FLD>9 S LIN=LIN+1 ;COMPENSATE FOR REMOVAL TIMES
"RTN","PSJLMUDE",148,0)
I FLD=7 S LIN=+$G(PSJLN)-1 Q:LIN<13
"RTN","PSJLMUDE",149,0)
D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IORVOFF_IOBOFF,0)
"RTN","PSJLMUDE",150,0)
Q
"RTN","PSJLMUDE",151,0)
;
"RTN","PSJLMUDE",152,0)
FORMATTX(PSJX) ;
"RTN","PSJLMUDE",153,0)
NEW PSJX1,Y,Y1
"RTN","PSJLMUDE",154,0)
S PSJX1=""
"RTN","PSJLMUDE",155,0)
F Y=1:1:$L(PSJX," ") S Y1=$P(PSJX," ",Y) D
"RTN","PSJLMUDE",156,0)
. I ($L(PSJX1)+$L(Y1)+1)>79 S:$E(PSJX1,1,1)=" " PSJX1=$E(PSJX1,2,$L(PSJX1)) S PSJL=PSJX1,PSJX1="" D
SETTMP
"RTN","PSJLMUDE",157,0)
. S PSJX1=PSJX1_Y1_" "
"RTN","PSJLMUDE",158,0)
I PSJX1]"" S PSJL=PSJX1 D SETTMP
"RTN","PSJLMUDE",159,0)
K PSJX1
"RTN","PSJLMUDE",160,0)
Q
"RTN","PSJLMUDE",161,0)
;
"RTN","PSJLMUDE",162,0)
1 ;;1,5,16,PSGPDN
"RTN","PSJLMUDE",163,0)
2 ;;3,5,16,PSGDO
"RTN","PSJLMUDE",164,0)
3 ;;4,58,7,PSGSDN
"RTN","PSJLMUDE",165,0)
4 ;;5,10,11,PSGMRN
"RTN","PSJLMUDE",166,0)
5 ;;6,59,6,PSGFDN
"RTN","PSJLMUDE",167,0)
6 ;;7,6,15,PSGSTN
"RTN","PSJLMUDE",168,0)
7 ;;18,5,14,PSGSMN
"RTN","PSJLMUDE",169,0)
8 ;;8,11,12,PSGSCH
"RTN","PSJLMUDE",170,0)
9 ;;9,8,13,PSGAT
"RTN","PSJLMUDE",171,0)
10 ;;10,11,10,PSGPRN
"RTN","PSJLMUDE",172,0)
11 ;;11,7,22,PSGSI
"RTN","PSJLMUDE",173,0)
ENKILL ;
"RTN","PSJLMUDE",174,0)
; 373 - Additionally, KILL off PSJALLGY
"RTN","PSJLMUDE",175,0)
K
PSGNOHI,PSGAT,PSGEB,PSGEFN,PSGFD,PSGHSM,PSGNEFD,PSGNESD,PSGOEEF,PSGOEER,PSGOFD,PSGO
HSM,PSGOMR,PSGOMRN,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGOSD,PSGOSM,PSGOST,PSGPD,PSGP
DN,PSGPR,PSGSD,PSGSM,PSJALLGY Q
"RTN","PSJLMUT1")
0^20^B76113417^B76113417
"RTN","PSJLMUT1",1,0)
PSJLMUT1 ;BIR/MLM - DRUG NAME DISPLAY ;Jul 05, 2018@08:53
"RTN","PSJLMUT1",2,0)
;;5.0;INPATIENT MEDICATIONS;**4,27,29,49,58,107,110,146,175,201,181,281,329,373**;16 DEC
97;Build 3
"RTN","PSJLMUT1",3,0)
;
"RTN","PSJLMUT1",4,0)
; Reference to ^PS(55 is supported by DBIA# 2191.
"RTN","PSJLMUT1",5,0)
; Reference to ^PS(50.7 is supported by DBIA# 2180.
"RTN","PSJLMUT1",6,0)
; Reference to ^PS(50.606 is supported by DBIA# 2174.
"RTN","PSJLMUT1",7,0)
; Reference to EN^PSODRDU2 is supported by DBIA# 2189.
"RTN","PSJLMUT1",8,0)
; Reference to ^PSDRUG( is supported by DBIA 2192.
"RTN","PSJLMUT1",9,0)
;
"RTN","PSJLMUT1",10,0)
DRGDISP(DFN,ON,NL,GL,NAME,DRUGONLY) ;
"RTN","PSJLMUT1",11,0)
;; DRUGONLY = 1/0 - Only the drug name will be returned.
"RTN","PSJLMUT1",12,0)
;; NL = The drug name display length
"RTN","PSJLMUT1",13,0)
;; GL = The give line display length, total length-6 ("Give: ")
"RTN","PSJLMUT1",14,0)
;; NAME(X) = Drug name and give line in displayable format.
"RTN","PSJLMUT1",15,0)
;; ON = IEN#_U/P (U=Unit Dose; P=Pending)
"RTN","PSJLMUT1",16,0)
;
"RTN","PSJLMUT1",17,0)
NEW F,OIND,MARX,MR,NOTGV,SCH,PSGUPDDO,PSGGV,X,PSGX,PSGINS,DRUGNAME
"RTN","PSJLMUT1",18,0)
K NAME S PSGINS=""
"RTN","PSJLMUT1",19,0)
S:ON["U" F="^PS(55,DFN,5,+ON,"
"RTN","PSJLMUT1",20,0)
I ON["P" S F="^PS(53.1,+ON,",X=$G(@(F_".3)")),PSGINS=$S(X]"":X,1:"")
"RTN","PSJLMUT1",21,0)
I $G(@(F_"0)"))="" S NAME(1)="NOT FOUND" Q
"RTN","PSJLMUT1",22,0)
S
OIND=$G(@(F_".2)")),PSGUPDDO=$P(OIND,U,2),X=@(F_"0)"),NOTGV=$P(X,U,22),MR=$$ENMRN^PSGMI
(+$P(X,U,3))
"RTN","PSJLMUT1",23,0)
I '+OIND,($P(X,U,4)'="U") NEW DRG D GTDRG^PSIVORFA F X="AD","SOL" Q:+OIND F PSGX=0:0 S
PSGX=$O(DRG(X,PSGX)) Q:'PSGX S OIND=$P(DRG(X,PSGX),U,6) Q:+OIND
"RTN","PSJLMUT1",24,0)
S SCH=$P($G(@(F_"2)")),U)
"RTN","PSJLMUT1",25,0)
I +$O(@(F_"1,0)")),'+$O(@(F_"1,1)")),PSGUPDDO="" D DD(F,.DRUGNAME)
"RTN","PSJLMUT1",26,0)
S:($G(DRUGNAME)=""!($G(DRUGNAME)["NOT FOUND")) DRUGNAME=$$OIDF(OIND)
"RTN","PSJLMUT1",27,0)
;S PSGGV=$S(NOTGV:"*** NOT TO BE GIVEN *** ",1:"")_PSGINS_PSGUPDDO_" "_MR_" "_SCH
"RTN","PSJLMUT1",28,0)
S PSGGV=$S(NOTGV:"*** NOT TO BE GIVEN ***
",1:"")_$S(('$D(PSJPDDDP)&('$L(PSGUPDDO))):PSGINS,1:PSGUPDDO)_" "_MR_" "_SCH
"RTN","PSJLMUT1",29,0)
S PSGX=0 K PSJPDDDP
"RTN","PSJLMUT1",30,0)
D TXT^PSGMUTL(DRUGNAME,NL) F X=0:0 S X=$O(MARX(X)) Q:'X S NAME(X)=$S(X>1:"
",1:"")_MARX(X),PSGX=X
"RTN","PSJLMUT1",31,0)
Q:+DRUGONLY
"RTN","PSJLMUT1",32,0)
D TXT^PSGMUTL(PSGGV,GL) F X=0:0 S X=$O(MARX(X)) Q:'X D
"RTN","PSJLMUT1",33,0)
. I X=1 S NAME(PSGX+X)="Give: "_MARX(X) Q
"RTN","PSJLMUT1",34,0)
. S NAME(PSGX+X)=$S(X>1:" ",1:"")_MARX(X)
"RTN","PSJLMUT1",35,0)
Q
"RTN","PSJLMUT1",36,0)
OIDF(OIND) ; Return Orderable Item name and Dosage form.
"RTN","PSJLMUT1",37,0)
;; +OIND = orderable item IEN
"RTN","PSJLMUT1",38,0)
NEW X,NAME
"RTN","PSJLMUT1",39,0)
S X=$G(^PS(50.7,+OIND,0))
"RTN","PSJLMUT1",40,0)
S:$P(X,U)]"" NAME=$P(X,U)_" "_$P($G(^PS(50.606,+$P(X,U,2),0)),U)
"RTN","PSJLMUT1",41,0)
Q $S($G(NAME)]"":NAME,1:"NOT FOUND "_+OIND_";PS(50.7")
"RTN","PSJLMUT1",42,0)
;
"RTN","PSJLMUT1",43,0)
DD(F,NAME) ; Return Dispense drug name.
"RTN","PSJLMUT1",44,0)
;; F = "^PS(55,DFN,5,+ON," or "^PS(53.1,+ON,"
"RTN","PSJLMUT1",45,0)
NEW X K NAME
"RTN","PSJLMUT1",46,0)
S X=$O(@(F_"1,0)")),X=$G(@(F_"1,"_+X_",0)"))
"RTN","PSJLMUT1",47,0)
I $P(X,U)]"" S NAME=$P($G(^PSDRUG(+X,0)),U)
"RTN","PSJLMUT1",48,0)
E S NAME="NOT FOUND "_+X_";PSDRUG"
"RTN","PSJLMUT1",49,0)
I '$O(@(F_"1,1)")),+$P(X,U,2)>1 S PSGUPDDO=+$P(X,U,2)
"RTN","PSJLMUT1",50,0)
S PSJPDDDP=1
"RTN","PSJLMUT1",51,0)
Q
"RTN","PSJLMUT1",52,0)
DSPLORDU(PSGP,ON) ; Display UD order for order check as in the Inpat Profile.
"RTN","PSJLMUT1",53,0)
NEW DRUGNAME,F,NODE0,NODE2,PSJID,PSJX,SCH,SD,STAT,X,Y
"RTN","PSJLMUT1",54,0)
S F=$S(ON["U":"^PS(55,PSGP,5,"_+ON_",",1:"^PS(53.1,"_+ON_",")
"RTN","PSJLMUT1",55,0)
S NODE0=$G(@(F_"0)")),NODE2=$G(@(F_"2)"))
"RTN","PSJLMUT1",56,0)
D DRGDISP^PSJLMUT1(PSGP,ON,39,54,.DRUGNAME,0)
"RTN","PSJLMUT1",57,0)
I ON["P",$P(NODE0,U,4)="F" D DSPLORDV(PSGP,ON) Q
"RTN","PSJLMUT1",58,0)
S SCH=$P(NODE0,U,7)
"RTN","PSJLMUT1",59,0)
S STAT=$P(NODE0,U,9) I STAT="A",$P(NODE0,U,27)="R" S STAT="R"
"RTN","PSJLMUT1",60,0)
I STAT="D" S STAT=$P(NODE0,U,28)
"RTN","PSJLMUT1",61,0)
I STAT'="P" S
PSJID=$E($$ENDTC^PSGMI($P(NODE2,U,2)),1,5),SD=$E($$ENDTC^PSGMI($P(NODE2,U,4)),1,5)
"RTN","PSJLMUT1",62,0)
I STAT="P" S (PSJID,SD)="*****",SCH="?"
"RTN","PSJLMUT1",63,0)
F PSJX=0:0 S PSJX=$O(DRUGNAME(PSJX)) Q:'PSJX D
"RTN","PSJLMUT1",64,0)
. S:PSJX=1 X=SCH_" "_PSJID_" "_SD_" "_$E(STAT,1,2)
"RTN","PSJLMUT1",65,0)
. S:PSJX=1 DRUGNAME(1)=$$SETSTR^VALM1(X,$E(DRUGNAME(1),1,40),42,20)
"RTN","PSJLMUT1",66,0)
. S PSJOC(ON,PSJLINE)=" "_DRUGNAME(PSJX)
"RTN","PSJLMUT1",67,0)
. S PSJLINE=PSJLINE+1
"RTN","PSJLMUT1",68,0)
Q
"RTN","PSJLMUT1",69,0)
DSPLORDV(DFN,ON) ; Display IV order for order check as in the Inpat Profile.
"RTN","PSJLMUT1",70,0)
N DRG,DRGI,DRGT,DRGX,FIL,ND,ON55,P,PSJIVFLG,PSJORIFN,TYP,X,Y,COMPDRG
"RTN","PSJLMUT1",71,0)
S TYP="?" I ON["V" D
"RTN","PSJLMUT1",72,0)
.S Y=$G(^PS(55,DFN,"IV",+ON,0)) F X=2,3,4,5,8,9,17,23 S P(X)=$P(Y,U,X)
"RTN","PSJLMUT1",73,0)
.S:P(17)="D" P(17)=$P(Y,U,25)
"RTN","PSJLMUT1",74,0)
.S TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I TYP'="O" S TYP="C"
"RTN","PSJLMUT1",75,0)
.S ON55=ON,P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I") D GTDRG^PSIVORFB,GTOT^PSIVUTL(P(4))
"RTN","PSJLMUT1",76,0)
S PSJCT=0,PSJL=""
"RTN","PSJLMUT1",77,0)
I ON'["V" S
(P(2),P(3))="",P(17)=$P($G(^PS(53.1,+ON,0)),U,9),Y=$G(^(8)),P(4)=$P(Y,U),P(8)=$P(Y,U,5),P(9)=$P($G(^(
2)),U) D GTDRG^PSIVORFA,GTOT^PSIVUTL(P(4))
"RTN","PSJLMUT1",78,0)
S PSJIVFLG=1 D PIVAD,SOL
"RTN","PSJLMUT1",79,0)
Q
"RTN","PSJLMUT1",80,0)
SOL ;
"RTN","PSJLMUT1",81,0)
S PSJL=$S($G(PSJIVFLG):PSJL,1:"")_" in"
"RTN","PSJLMUT1",82,0)
S DRG=0 F S DRG=+$O(DRG("SOL",DRG)) Q:'DRG D NAME^PSIVUTL(DRG("SOL",DRG),37,.NAME,0) S
DRGX=0 F S DRGX=$O(NAME(DRGX)) Q:'DRGX D
"RTN","PSJLMUT1",83,0)
.S COMPDRG="",COMPDRG=$P(DRG("SOL",DRG),"^",2)_" "_$P(DRG("SOL",DRG),"^",3)
"RTN","PSJLMUT1",84,0)
.I PSJL[" in" D
"RTN","PSJLMUT1",85,0)
..I $D(PSJP(2)),COMPDRG=PSJP(2) S NAME(DRGX)="*"_NAME(DRGX) Q
"RTN","PSJLMUT1",86,0)
..I $D(PSJOCDT(10,COMPDRG))!($D(PSJOCDT(20,COMPDRG))) D Q ;PSJ*5*281 - identify the interacting
drugs with an *
"RTN","PSJLMUT1",87,0)
...S NAME(DRGX)="*"_NAME(DRGX) Q
"RTN","PSJLMUT1",88,0)
.I PSJL'[" in" S NAME(DRGX)=NAME(DRGX)
"RTN","PSJLMUT1",89,0)
.S PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,13,60) D:$G(PSJIVFLG) PIV1 D SETTMP S PSJL=" "
"RTN","PSJLMUT1",90,0)
Q
"RTN","PSJLMUT1",91,0)
PIVAD ; Print IV Additives.
"RTN","PSJLMUT1",92,0)
F DRG=0:0 S DRG=$O(DRG("AD",DRG)) Q:'DRG D NAME^PSIVUTL(DRG("AD",DRG),39,.NAME,1) F
DRGX=0:0 S DRGX=$O(NAME(DRGX)) Q:'DRGX D
"RTN","PSJLMUT1",93,0)
.D ;PSJ*5*281 - identify the interacting drugs with an *
"RTN","PSJLMUT1",94,0)
..I $D(PSJP(2)),NAME(DRGX)=PSJP(2) S NAME(DRGX)="*"_NAME(DRGX) Q
"RTN","PSJLMUT1",95,0)
..I $D(PSJOCDT(10,NAME(DRGX)))!($D(PSJOCDT(20,NAME(DRGX)))) S NAME(DRGX)="*"_NAME(DRGX)
Q
"RTN","PSJLMUT1",96,0)
..S NAME(DRGX)=" "_NAME(DRGX)
"RTN","PSJLMUT1",97,0)
.S PSJL=$$SETSTR^VALM1(NAME(DRGX),PSJL,9,60) D:$G(PSJIVFLG) PIV1 D SETTMP
"RTN","PSJLMUT1",98,0)
Q
"RTN","PSJLMUT1",99,0)
;
"RTN","PSJLMUT1",100,0)
PIV1 ; Print Sched type, start/stop dates, and status.
"RTN","PSJLMUT1",101,0)
K PSJIVFLG
"RTN","PSJLMUT1",102,0)
;373 start
"RTN","PSJLMUT1",103,0)
;F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5))
"RTN","PSJLMUT1",104,0)
;I '$D(PSJEXTP) S
PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1),PSJL=$$SETSTR^VALM1(P(2),PSJL,53,7),PSJL=$$SETSTR^VALM1(P
(3),PSJL,60,7),PSJL=$$SETSTR^VALM1(P(17),PSJL,67,2)
"RTN","PSJLMUT1",105,0)
;E S
PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1),PSJL=$$SETSTR^VALM1(P(2),53,7),PSJL=$$SETSTR^VALM1(P(3),P
SJL,63,7),PSJL=$$SETSTR^VALM1(P(17),PSJL,73,2)
"RTN","PSJLMUT1",106,0)
F X=2,3 S P(X)=$E($$ENDTC2^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:10))
"RTN","PSJLMUT1",107,0)
I '$D(PSJEXTP) S
PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1),PSJL=$$SETSTR^VALM1(P(2),PSJL,53,10),PSJL=$$SETSTR^VALM1(
P(3),PSJL,64,10),PSJL=$$SETSTR^VALM1(P(17),PSJL,75,2)
"RTN","PSJLMUT1",108,0)
E S
PSJL=$$SETSTR^VALM1(TYP,PSJL,50,1),PSJL=$$SETSTR^VALM1(P(2),53,10),PSJL=$$SETSTR^VALM1(P(3),
PSJL,64,10),PSJL=$$SETSTR^VALM1(P(17),PSJL,75,2)
"RTN","PSJLMUT1",109,0)
;373 end
"RTN","PSJLMUT1",110,0)
Q
"RTN","PSJLMUT1",111,0)
SETTMP ;
"RTN","PSJLMUT1",112,0)
S PSJOC(ON,PSJLINE)=PSJL,PSJLINE=PSJLINE+1
"RTN","PSJLMUT1",113,0)
Q
"RTN","PSJLMUT1",114,0)
ORDCHK(DFN,TYPE,PIECE) ;
"RTN","PSJLMUT1",115,0)
;TYPE ="DD" - Duplicate drug
"RTN","PSJLMUT1",116,0)
; ="DC" - Duplicate class
"RTN","PSJLMUT1",117,0)
; -"DI" - Drug Interaction
"RTN","PSJLMUT1",118,0)
;PIECE = The piece order number is return from ^TMP($J,"DD"...
"RTN","PSJLMUT1",119,0)
;PSJOC(ON,x) = Array of inpatient orders to be displayed
"RTN","PSJLMUT1",120,0)
;
"RTN","PSJLMUT1",121,0)
NEW ON,PSJL,PSIVX,PSJOC,PSJORIEN,PSJPACK,PSJLINE
"RTN","PSJLMUT1",122,0)
S PSJOC=0,PSJLINE=1
"RTN","PSJLMUT1",123,0)
F PSIVX=0:0 S PSIVX=$O(^TMP($J,TYPE,PSIVX)) Q:'PSIVX D
"RTN","PSJLMUT1",124,0)
. S PSJPACK=$P(^TMP($J,TYPE,PSIVX,0),U,PIECE)
"RTN","PSJLMUT1",125,0)
. I $G(PSGORD) S PSJORD=PSGORD ; Set PSJORD if PSGORD exists and is not Null
"RTN","PSJLMUT1",126,0)
. I $G(PSJORD)]"" I
$S($D(PSJORD):$G(PSJORD),1:$G(PSGORD))'["V",$P(PSJPACK,";")=$S($D(PSJORD):$G(PSJORD),1:$G(PSG
ORD)) Q ; don't flag order that is being renewed as duplicate, only checks Unit Dose orders
"RTN","PSJLMUT1",127,0)
. I $G(PSJCOM),($G(PSJORD)["P") Q:$D(^PS(53.1,"ACX",PSJCOM,+PSJPACK))
"RTN","PSJLMUT1",128,0)
. ; Don't flag if pending renewal from CPRS
"RTN","PSJLMUT1",129,0)
. I
$G(PSJORD)]"",(PSJORD["P"),($P($G(^PS(53.1,+PSJORD,0)),"^",24)="R"),($P(PSJPACK,";")["U"),($P($G(^P
S(55,DFN,5,+$P(PSJPACK,";"),0)),"^",27)="R"),($P($G(^PS(55,DFN,5,+$P(PSJPACK,";"),0)),"^",26)=PSJORD
) Q
"RTN","PSJLMUT1",130,0)
. I $G(PSIVRNFG),$G(ON55)["V",$P(PSJPACK,";")=$G(ON55) Q ;PSIVRNFG set and kill in R+2^PSIVOPT2.
Needed to do dupl. check on new order but not renew.
"RTN","PSJLMUT1",131,0)
. S PSJORIEN=$P(^TMP($J,TYPE,PSIVX,0),U,PIECE-1)
"RTN","PSJLMUT1",132,0)
. I TYPE="DI",($P(^TMP($J,TYPE,PSIVX,0),U,4)="CRITICAL") S PSJIREQ=1
"RTN","PSJLMUT1",133,0)
. ; Adding Drug Interactions check for use in Intervention defaults in PSJRXI.
"RTN","PSJLMUT1",134,0)
. I TYPE="DI" S PSJRXREQ=$S($P(^TMP($J,TYPE,PSIVX,0),U,4)="CRITICAL":"CRITICAL DRUG
INTERACTION",1:"SIGNIFICANT DRUG INTERACTION")
"RTN","PSJLMUT1",135,0)
. ;I $P(PSJPACK,";",2)["O" D Q
"RTN","PSJLMUT1",136,0)
. N X S X=$P(PSJPACK,";",2) I X["O" D Q
"RTN","PSJLMUT1",137,0)
.. D:PSJFST=1 PAUSE
"RTN","PSJLMUT1",138,0)
.. W !!,"The patient has this "_$S($P(PSJPACK,";")["N":"Non-VA
Meds",$P(PSJPACK,";",2)["O":"Outpatient",1:"")_" order:",!
"RTN","PSJLMUT1",139,0)
.. I $D(^TMP($J,TYPE,PSIVX,1)) D SHOR^PSJLMUT2(TYPE,PSIVX),PAUSE S
PSJFST=$S(PSJFST=0:PSJFST+2,1:PSJFST+1) Q
"RTN","PSJLMUT1",140,0)
.. D EN^PSODRDU2(DFN,PSJPACK,"PSJPRE"),PAUSE S
PSJPDRG=1,PSJFST=$S(PSJFST=0:PSJFST+2,1:PSJFST+1)
"RTN","PSJLMUT1",141,0)
. S ON=$P(PSJPACK,";") Q:$D(PSJOC(ON))
"RTN","PSJLMUT1",142,0)
. I ON=$G(PSIVOCON),+PSJORIEN Q
"RTN","PSJLMUT1",143,0)
. I ON=$G(PSIVOCON),'+PSJORIEN D SETPSJOC Q
"RTN","PSJLMUT1",144,0)
. ;S PSJOC=PSJOC+1,PSJPDRG=1 D:PSJOC=1 WRITE(TYPE)
"RTN","PSJLMUT1",145,0)
. I ON["V" D
"RTN","PSJLMUT1",146,0)
.. I '$O(^PS(55,DFN,"IV",+ON,0)) D SETPSJOC Q
"RTN","PSJLMUT1",147,0)
.. D DSPLORDV(DFN,ON) S PSJOC=PSJOC+1
"RTN","PSJLMUT1",148,0)
. I ON'["V" D DSPLORDU(DFN,ON) S PSJOC=PSJOC+1
"RTN","PSJLMUT1",149,0)
. S PSJOC(ON,PSJLINE)="",PSJLINE=PSJLINE+1
"RTN","PSJLMUT1",150,0)
D:PSJOC WRITE(TYPE)
"RTN","PSJLMUT1",151,0)
S ON="" F S ON=$O(PSJOC(ON)) Q:ON="" W ! S PSJLINE=PSJLINE+1,PSJFST=PSJFST+1 D
"RTN","PSJLMUT1",152,0)
. F PSIVX=0:0 S PSIVX=$O(PSJOC(ON,PSIVX)) Q:'PSIVX W !,PSJOC(ON,PSIVX) S PSJLINE=PSJLINE+1
D:'(PSIVX#6) PAUSE
"RTN","PSJLMUT1",153,0)
W !
"RTN","PSJLMUT1",154,0)
Q
"RTN","PSJLMUT1",155,0)
SETPSJOC ;Set PSJOC array to be displayed later
"RTN","PSJLMUT1",156,0)
NEW PIECE S PIECE=$S(TYPE="DC":4,1:2)
"RTN","PSJLMUT1",157,0)
S X=$$SETSTR^VALM1($P(^TMP($J,TYPE,PSIVX,0),U,PIECE),"",9,40)
"RTN","PSJLMUT1",158,0)
S X=$$SETSTR^VALM1("* EXISTS IN CURRENT ORDER *",X,50,27)
"RTN","PSJLMUT1",159,0)
S PSJOC(ON,PSJLINE)=X,PSJLINE=PSJLINE+1,PSJOC=PSJOC+1
"RTN","PSJLMUT1",160,0)
Q
"RTN","PSJLMUT1",161,0)
WRITE(TYPE) ;Display order check description
"RTN","PSJLMUT1",162,0)
S PSJPDRG=1
"RTN","PSJLMUT1",163,0)
I TYPE="DD" W !!,"This patient is already receiving the following order",$S(PSJOC>1:"s",1:"")," for
",$S($G(PSJDD)]"":$P($G(^PSDRUG(PSJDD,0)),U),1:"this drug"),":",!
"RTN","PSJLMUT1",164,0)
I TYPE="DC" W !!,"This patient is already receiving ",$S(PSJOC>1:"orders",1:"an order")," for the
following drug",$S(PSJOC>1:"s",1:"")," in the same",!,"class as
",$S($G(PSJDD)]"":$P($G(^PSDRUG(PSJDD,0)),U),1:"the drug selected"),":",!
"RTN","PSJLMUT1",165,0)
I TYPE="DI" W !!,"This patient is receiving the following medication",$S(PSJOC>1:"s",1:"")," that
ha",$S(PSJOC>1:"ve",1:"s")," an interaction",!,"with ",$P($G(^PSDRUG(PSJDD,0)),U),":",!
"RTN","PSJLMUT1",166,0)
Q
"RTN","PSJLMUT1",167,0)
PAUSE ;
"RTN","PSJLMUT1",168,0)
K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue...",DIR("?")="Press Return to continue..." D
^DIR W !
"RTN","PSJLMUT1",169,0)
Q
"RTN","PSJO")
0^21^B38311282^B37148695
"RTN","PSJO",1,0)
PSJO ;BIR/CML3,PR - GET AND PRINT INPATIENT ORDERS ;Jul 16, 2018@08:25
"RTN","PSJO",2,0)
;;5.0;INPATIENT MEDICATIONS;**31,58,110,181,267,275,317,373**;16 DEC 97;Build 3
"RTN","PSJO",3,0)
;
"RTN","PSJO",4,0)
; Reference to ^PSD(58.8 supported by DBIA #2283.
"RTN","PSJO",5,0)
; Reference to ^PSI(58.1 supported by DBIA #2284.
"RTN","PSJO",6,0)
; Reference to ^PS(55 supported by DBIA #2191.
"RTN","PSJO",7,0)
; Reference to $$GET^XPAR supported by #2263
"RTN","PSJO",8,0)
;
"RTN","PSJO",9,0)
K ^TMP("PSJON",$J),^TMP("PSJ",$J) N TF2 D @$S($D(PSJEXTP):"EN^PSJH1",1:"EN^PSJO1(3)")
"RTN","PSJO",10,0)
S PSJDEV=IO'=IO(0)!($E(IOST,1,2)'="C-"),(NP,TF2,PSGON,PSJON)=""
"RTN","PSJO",11,0)
U IO D ENGET^PSJO3 I '$D(^TMP("PSJ",$J)) W !,SLS,SLS,$E(SLS,1,25),!!?22,"NO ORDERS FOUND FOR
",$S(PSJOL="S":"SHORT",1:"LONG")," PROFILE."
"RTN","PSJO",12,0)
E S (PSJC,PSJS,PSJO,PSJST)="" F S PSJC=$O(^TMP("PSJ",$J,PSJC)) Q:PSJC="" D G:NP["^" DONE
"RTN","PSJO",13,0)

.D:$S(($P(PSJC,"^")="Cz")&($P(PSJC,"^",2)'=TF2):1,(($P(PSJC,"^")'="Cz")&PSJC["B"&'TF):0,($P(PSJC,"^")'=
"Cz"&(PSJC'["A")):1,($P(PSJC,"^")="Cz"&(TF2=$P(PSJC,"^",2))):0,1:1) TF
"RTN","PSJO",14,0)
.F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q:PSJST="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS))
Q:PSJS=""!(NP[U) D ON
"RTN","PSJO",15,0)
G:NP[U DONE I PSJDEV,$S('$D(PSJPRP):1,1:PSJPRP="P") D BOT
"RTN","PSJO",16,0)
;
"RTN","PSJO",17,0)
DONE ;
"RTN","PSJO",18,0)
I $S('$D(PSJPRP):1,1:PSJPRP="P") K ^TMP("PSJ",$J)
"RTN","PSJO",19,0)
S PSGON=PSJON K:'$D(PSGVBW) PSGODT K
%,%H,%I,C,DN,DO,DRG,FQ,GIVE,HDT,I,JJ,LN2,N,ND,ND4,ND6,NF,NP,O,ON,ORIFN,ORTX,P,PF,PG,PS,PSGID
,PSGOD,PSIVSC,PSIVST,PSIVTY,PSJC,PSJDEV,PSJF,PSJO,PSJOS,PSJS,PSJSCHT,PSJST,QQ,RB,RTE,SCH,SD,SLS,
SM
"RTN","PSJO",20,0)
K ST,START,STAT,SUB,TF,TYP,UDU,UPD,V,WS,X,X1,X2,Y Q
"RTN","PSJO",21,0)
;
"RTN","PSJO",22,0)
ON ;
"RTN","PSJO",23,0)
S PSJSCHT=$S(PSJOS:PSJS,1:PSJST)
"RTN","PSJO",24,0)
F FQ=0:0 S PSJO=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS,PSJO)) Q:PSJO="" S DN=^(PSJO) D:$Y+6>IOSL
ENNP^PSJO3 Q:NP["^" D ;
"RTN","PSJO",25,0)
.I $P(PSJC,"^")="Cz",($P(PSJC,"^",2)]"") S PSJF="^PS("_$S($P(PSJC,"^",4)'["C":"55,"_PSGP_",5,",1:"53.1,")
"RTN","PSJO",26,0)
.S PSJON=PSJON+1 S:'PSJDEV ^TMP("PSJON",$J,PSJON)=PSJO W !,$J(PSJON,4),?5 D
@$S(PSJO["V":"PIV^PSIVUTL(PSJO)",PSJO["U":"PUD",1:"PIV^PSIVUTL(PSJO)")
"RTN","PSJO",27,0)
Q
"RTN","PSJO",28,0)
;
"RTN","PSJO",29,0)
PUD ; print unit dose
"RTN","PSJO",30,0)
; Naked reference below refers to full reference ^PS(53.1,+PSJO,0) or ^PS(55,DFN,5,+PSJO,0) using
indirection.
"RTN","PSJO",31,0)
I PSJO["U" S:'$$CLINIC^PSJO1(PSGP,PSJO) C=$G(PSJC)
"RTN","PSJO",32,0)
I PSJO["P" S:'$$CLINIC^PSJO1(PSGP,PSJO) C=$G(PSJC)
"RTN","PSJO",33,0)
S
ND=$S($D(@(PSJF_+PSJO_",0)")):^(0),1:""),SCH=$G(^(2)),ND4=$G(^(4)),ND6=$P($G(^(6)),"^"),DO=$S($P
(DN,"^",2)=.2:$P($G(@(PSJF_+PSJO_",.2)")),"^",2),1:$G(@(PSJF_+PSJO_",.3)")))
"RTN","PSJO",34,0)
I ("AO"[PSJC)!(PSJC="DF") D
"RTN","PSJO",35,0)
.S V='$P(ND4,"^",UDU),V=$S(+PSJSYSU=1&V:1,+PSJSYSU=3&V:1,1:0)
"RTN","PSJO",36,0)
.W $S(ND4="":"
",$P(ND4,"^",12):"D",$P(ND4,"^",18)&($P(ND4,"^",19)!V):"H",$P(ND4,"^",22)&($P(ND4,"^",23)!V):"H",$
P(ND4,"^",15)&($P(ND4,"^",16)!V):"R",1:" ")
"RTN","PSJO",37,0)
.W $S($P($G(@(PSJF_+PSJO_",.2)")),"^",4)="D":"d",1:" ")_$S(V:"->",1:" ")
"RTN","PSJO",38,0)
I $S(PSJC["NZ":0,1:PSJC["N") W $S($P(ND4,"^",12):"D",1:" ")
"RTN","PSJO",39,0)
S
RTE=$P(ND,"^",3),SM=$S('$P(ND,"^",5):0,$P(ND,"^",6):1,1:2),STAT=$S($P(ND,"^",28)]"":$P(ND,"^",28),$
P(ND,"^",9)]"":$P(ND,"^",9),1:"NF")
"RTN","PSJO",40,0)
S PF=$E("*",$P(ND,"^",20)>0),PSGID=$P(SCH,"^",2),SD=$P(SCH,"^",4),SCH=$P(SCH,"^")
"RTN","PSJO",41,0)
I STAT="A",$P(ND,U,27)="R" S STAT="R"
"RTN","PSJO",42,0)
S NF=$P(DN,"^",2),WS=$S(PSJPWD:$$WS(PSJPWD,PSGP,PSJF,PSJO),1:0)
"RTN","PSJO",43,0)
; PSJ*5*317 - If PSJ PADE OE BALANCES parameter is YES, PADE balances should display.
"RTN","PSJO",44,0)
N PADE S PADE=0 I $$GET^XPAR("SYS","PSJ PADE OE BALANCES") D
"RTN","PSJO",45,0)
.N PSJTMNOE
"RTN","PSJO",46,0)
.S PSJTMNOE=$G(PSJNEWOE) N PSJNEWOE S PSJNEWOE=PSJTMNOE
"RTN","PSJO",47,0)
.I '$G(VAIN(4)),$G(PSGP) N VAIN,DFN S DFN=PSGP D INP^VADPT
"RTN","PSJO",48,0)
.Q:'$$PADEWD^PSJPAD50(+$G(VAIN(4)))
"RTN","PSJO",49,0)
.S PADE=$$DRGFLAG^PSJPADSI(PSGP,PSJO,,$G(ON),$G(PSJNEWOE)) S:PADE=0 PADE=1
"RTN","PSJO",50,0)
NEW MARX,PSJRNDT
"RTN","PSJO",51,0)
S:($P(PSJC,"^")'="Cz") PSJORFLG=$S(PSJC["A":"U",PSJC["O":"U",PSJC="DF":"U",1:"P")
"RTN","PSJO",52,0)
S:($P(PSJC,"^")="Cz")
PSJORFLG=$S($P(PSJC,"^",4)["A":"U",($P(PSJC,"^",4)["O"):"U",($P(PSJC,"^",4)["DF"):"U",1:"P")
"RTN","PSJO",53,0)
;S PSJRNDT=$$LASTREN^PSJLMPRI(DFN,PSJO) S:PSJRNDT PSJRNDT=$E($$ENDTC^PSGMI(+PSJRNDT),1,5)
;#373
"RTN","PSJO",54,0)
S PSJRNDT=$$LASTREN^PSJLMPRI(DFN,PSJO) S:PSJRNDT
PSJRNDT=$E($$ENDTC2^PSGMI(+PSJRNDT),1,10) ;#373
"RTN","PSJO",55,0)
;D DRGDISP^PSJLMUT1(PSGP,+PSJO_PSJORFLG,40,54,.MARX,0) ;#373
"RTN","PSJO",56,0)
D DRGDISP^PSJLMUT1(PSGP,+PSJO_PSJORFLG,34,28,.MARX,0) ;#373
"RTN","PSJO",57,0)
F X=0:0 S X=$O(MARX(X)) Q:'X W @($S(X=1:"?9",1:"!?11")),$S($E(PSJS)="*":$P(PSJS,"^"),1:MARX(X)) D
;D:X=1 #373
"RTN","PSJO",58,0)
. ;W ?50,$S(PSJC["NZ":"?",PSJSCHT'="z":PSJSCHT,1:"?") ;#373
"RTN","PSJO",59,0)
. I X=1 W ?46,$S(PSJC["NZ":"?",PSJSCHT'="z":PSJSCHT,1:"?") ;#373
"RTN","PSJO",60,0)
. ;W:'$D(PSJEXTP)
?53,$S(PSJC["NZ":"*****",1:$E($$ENDTC^PSGMI(PSGID),1,5)),?60,$S(PSJC["NZ":"*****",1:$E($$ENDTC
^PSGMI(SD),1,5)),?67,STAT ;#373
"RTN","PSJO",61,0)
. I X=1 W:'$D(PSJEXTP)
?49,$S(PSJC["NZ":"*****",1:$E($$ENDTC2^PSGMI(PSGID),1,10)),?60,$S(PSJC["NZ":"*****",1:$E($$END
TC2^PSGMI(SD),1,10)),?71,STAT ;#373
"RTN","PSJO",62,0)
. ;W:$D(PSJEXTP)
?53,$S(PSJC["NZ":"*****",1:$E($$ENDTC^PSGMI(PSGID),1,8)),?63,$S(PSJC["NZ":"*****",1:$E($$ENDTC
^PSGMI(SD),1,8)),?73,STAT ;#373
"RTN","PSJO",63,0)
. I X=1 W:$D(PSJEXTP)
?49,$S(PSJC["NZ":"*****",1:$E($$ENDTC2^PSGMI(PSGID),1,10)),?60,$S(PSJC["NZ":"*****",1:$E($$END
TC2^PSGMI(SD),1,10)),?71,STAT ;#373
"RTN","PSJO",64,0)
. ;I NF!WS!SM!PF!$G(PADE)!(PSJRNDT]"") W ?71 W:NF "NF " W:(WS&'PADE) "WS " W:(WS&PADE) "WP
" W:(PADE&'WS) "PD " W:SM $E("HSM",SM,3) W:$G(PSJRNDT) PSJRNDT W:PF ?79,"*" ;#373
"RTN","PSJO",65,0)
. I X=1 D ;#373
"RTN","PSJO",66,0)
.. I NF!WS!SM!PF!$G(PADE) W ?74 W:NF "NF " W:(WS&'PADE) "WS " W:(WS&PADE) "WP "
W:(PADE&'WS) "PD " W:SM $E("HSM",SM,3) W:PF ?78,"*" ;#373
"RTN","PSJO",67,0)
. I X=2,PSJRNDT]"" W ?49,"Renewed: ",PSJRNDT ;#373
"RTN","PSJO",68,0)
I '$D(MARX(2)),PSJRNDT]"" W !?49,"Renewed: ",PSJRNDT ;#373
"RTN","PSJO",69,0)
I ND6]"" S Y=$$ENSET^PSGSICHK(ND6) D K ^PS(53.45,DUZ,5)
"RTN","PSJO",70,0)
.D GETSI^PSJBCMA5(DFN,PSJO) I $G(^PS(53.45,DUZ,5)) N TXTLN S TXTLN=0 F S
TXTLN=$O(^PS(53.45,DUZ,5,TXTLN)) Q:'TXTLN D
"RTN","PSJO",71,0)
..W !?11,$G(^PS(53.45,DUZ,5,TXTLN,0))
"RTN","PSJO",72,0)
.W !?11 F X=1:1:$L(Y," ") S V=$P(Y," ",X) W:$L(V)+$X>66 !?11 W V_" "
"RTN","PSJO",73,0)
K PSJORFLG
"RTN","PSJO",74,0)
Q
"RTN","PSJO",75,0)
;
"RTN","PSJO",76,0)
TF ;
"RTN","PSJO",77,0)
NEW SLS,C S SLS="",C=PSJC,$P(SLS," -",40)=""
"RTN","PSJO",78,0)
S
LN2=$S(($P(C,"^")="Cz"):$$TXT(C),C="A":$$TXT(C),C["CC":$$TXT("PR"),C["CD":$$TXT("PC"),C["BD":$$TX
T("NC"),C["C":$$TXT("P"),C["B":$$TXT("N"),C["NX":$$TXT("N"),C["DF":$$TXT("DF"),C["NZ":$$TXT("P"),1:
$$TXT("NA"))
"RTN","PSJO",79,0)
W:$D(^TMP("PSJ",$J,PSJC)) !,$E($E(SLS,1,(80-$L(LN2))/2)_" "_LN2_$E(SLS,1,(80-$L(LN2))/2),1,80)
"RTN","PSJO",80,0)
S PSJF="^PS("_$S(PSJC'["C":"55,"_PSGP_",5,",1:"53.1,") S TF=$S(PSJC["C":0,1:TF)
"RTN","PSJO",81,0)
I $P(PSJC,"^")="Cz",($P(PSJC,"^",2)]"") S
PSJF="^PS("_$S($P(PSJC,"^",4)'["C":"55,"_PSGP_",5,",1:"53.1,"),TF2=$P(PSJC,"^",2)
"RTN","PSJO",82,0)
Q
"RTN","PSJO",83,0)
;
"RTN","PSJO",84,0)
TXT(X) ;
"RTN","PSJO",85,0)
I $G(X)="" Q ""
"RTN","PSJO",86,0)
I X="A" Q "A C T I V E"
"RTN","PSJO",87,0)
S PSJDCEXP=$$RECDCEXP^PSJP()
"RTN","PSJO",88,0)
I $P(X,"^")="Cz" Q $P(X,"^",2)
"RTN","PSJO",89,0)
I X="DF" Q "RECENTLY DISCONTINUED/EXPIRED (LAST "_+$G(PSJDCEXP)_" HOURS)"
"RTN","PSJO",90,0)
I X="N" Q "N O N - V E R I F I E D"
"RTN","PSJO",91,0)
I X="NA" Q "N O N - A C T I V E"
"RTN","PSJO",92,0)
I X="NC" Q "N O N - V E R I F I E D C O M P L E X"
"RTN","PSJO",93,0)
I X="P" Q "P E N D I N G"
"RTN","PSJO",94,0)
I X="PC" Q "P E N D I N G C O M P L E X"
"RTN","PSJO",95,0)
I X="PR" Q "P E N D I N G R E N E W A L S"
"RTN","PSJO",96,0)
Q ""
"RTN","PSJO",97,0)
;
"RTN","PSJO",98,0)
BOT ; print name, ssn, and dob on bottom of page
"RTN","PSJO",99,0)
F Q=$Y:1:IOSL-4 W !
"RTN","PSJO",100,0)
W !,?2,$P(PSGP(0),"^"),?40,PSJPPID,?70,$E($P(PSJPDOB,"^",2),1,8)
"RTN","PSJO",101,0)
Q
"RTN","PSJO",102,0)
WS(PSJPWD,PSGP,PSJF,PSJO) ; - WARD STOCK flag, input=(ward,dfn,file root,order)
"RTN","PSJO",103,0)
; Naked reference below refers to full reference ^PS(55,DFN,5,+PSJO,1,"B",PSWS) using indirection.
"RTN","PSJO",104,0)
S WS=0,PSJF=PSJF_+PSJO_",1,""B"")" I $D(@PSJF) N PSWS S PSWS=0 F S PSWS=$O(^("B",PSWS))
Q:'PSWS S WS=$$WSCHK(PSJPWD,PSWS) Q:WS
"RTN","PSJO",105,0)
Q WS
"RTN","PSJO",106,0)
;
"RTN","PSJO",107,0)
WSCHK(PSJPWD,PSWS) ; Determine if drug is ward stock item.
"RTN","PSJO",108,0)
Q $S(PSJPWD:$S($D(^PSI(58.1,"D",PSWS,PSJPWD)):1,$D(^PSD(58.8,"D",PSWS,PSJPWD)):1,1:0),1:0)
"RTN","PSJOE1")
0^22^B32599287^B32598956
"RTN","PSJOE1",1,0)
PSJOE1 ;BIR/CML3 - UD OE FOR COMBINED OE ;Jul 02, 2018@10:42
"RTN","PSJOE1",2,0)
;;5.0;INPATIENT MEDICATIONS;**2,7,25,30,47,56,64,179,181,252,281,315,338,373**;16 DEC 97;Build 3
"RTN","PSJOE1",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","PSJOE1",4,0)
; Reference to ^DICN is supported by DBIA# 10009
"RTN","PSJOE1",5,0)
; Reference to ^VALM is supported by DBIA# 10118
"RTN","PSJOE1",6,0)
; Reference to ^TMP("PSODAOC",$J supported by DBIA 6071
"RTN","PSJOE1",7,0)
;
"RTN","PSJOE1",8,0)
S PC=0 G AD
"RTN","PSJOE1",9,0)
;
"RTN","PSJOE1",10,0)
EN ;
"RTN","PSJOE1",11,0)
S PC=0
"RTN","PSJOE1",12,0)
;
"RTN","PSJOE1",13,0)
AD ; Ask Drug
"RTN","PSJOE1",14,0)
;PSJOCFG - If defined, it's for new order, renew or copy. ^PSJOCDSD using this flag to not display drug
error.
"RTN","PSJOE1",15,0)
K PSJOCFG,PSGDUR,PSGRMVT,PSGRMV,PSGRF,ND2P1 ;*315
"RTN","PSJOE1",16,0)
N PSJNORD,PSGORQF,PSGSDX,PSGFDX,PSGNEFDO,PSGEDTOI,PSJOCFG,PSGDREQ S PSJOCFG="NEW UD"
S PSJNORD=1 I $D(VALM("TM")) S IOTM=VALM("TM"),IOBM=IOSL W IOSC,@IOSTBM,IORC
"RTN","PSJOE1",17,0)
K PSGORQF
"RTN","PSJOE1",18,0)
D ^PSGOE7
"RTN","PSJOE1",19,0)
I $G(PSGORQF) S PSJORQF=1 G DONE
"RTN","PSJOE1",20,0)
S PC=1,PSJORQF=0 I X?1"S."1.E D ^PSGOES G AD
"RTN","PSJOE1",21,0)
D ^PSGOE4:'$P(PSJSYSP0,"^",12),^PSGOE3:$P(PSJSYSP0,"^",12)
"RTN","PSJOE1",22,0)
G:$G(PSGOROE1)=1 AD
"RTN","PSJOE1",23,0)
K PSGEFN,PSGOEEF,PSGOEE,PSGOEOS S PSGEFN="1:13" F X=1:1:13 S PSGEFN(X)=""
"RTN","PSJOE1",24,0)
S
PSGPDN=$$OINAME^PSJLMUTL(PSGPDRG),PSGPD=PSGPDRG,PSGOINST="",PSGSDN=$$ENDD^PSGMI(PS
GNESD)_U_$$ENDTC^PSGMI(PSGNESD),PSGFDN=$$ENDD^PSGMI(PSGNEFD)_U_$$ENDTC^PSGMI(PSGN
EFD)
"RTN","PSJOE1",25,0)
S:$D(PSJOCFG)
PSGSDN=$$ENDD^PSGMI(PSGNESD)_U_$$ENDTC2^PSGMI(PSGNESD),PSGFDN=$$ENDD^PSGMI(PSGNE
FD)_U_$$ENDTC2^PSGMI(PSGNEFD) ;#373
"RTN","PSJOE1",26,0)
S
PSGAT=PSGS0Y,PSGLIN=$$ENDD^PSGMI(PSGDT)_U_$$ENDTC^PSGMI(PSGDT),PSGLI=PSGDT,PSGEBN=$$
ENNPN^PSGMI(DUZ),PSGSTAT=$S(PSGOEAV:"ACTIVE",1:"NON-VERIFIED")
"RTN","PSJOE1",27,0)
D
CHK^PSGOEV("^^"_PSGMR_"^^^^"_PSGST,PSGPDRG_U_PSGDO,PSGSCH_U_PSGNESD_"^^"_PSGNEFD)
"RTN","PSJOE1",28,0)
S PSGSD=PSGNESD,PSGFD=PSGNEFD
"RTN","PSJOE1",29,0)
K PSJACEPT S VALMBCK="Q" D:$D(Y) EN^VALM("PSJU LM ACCEPT")
"RTN","PSJOE1",30,0)
I $G(PSJACEPT)=1 D
"RTN","PSJOE1",31,0)
. D OC
"RTN","PSJOE1",32,0)
. ;D:'$G(PSGORQF) IN^PSJOCDS($G(PSGORD),"UD",+$G(PSGDRG))
"RTN","PSJOE1",33,0)
;If intervention is not log then quit
"RTN","PSJOE1",34,0)
I $G(PSGORQF)=1 S PSJACEPT=0
"RTN","PSJOE1",35,0)
S PSJNOO=-1 I $G(PSJACEPT)=1 S PSJNOO=$$ENNOO^PSJUTL5("N")
"RTN","PSJOE1",36,0)
I $G(PSJNOO)<0 K PSJACEPT W !,"No order created." G AD
"RTN","PSJOE1",37,0)
K PSGOEE D ^PSGOETO S PSJORD=PSGORD
"RTN","PSJOE1",38,0)
S ^TMP("PSODAOC",$J,"IP IEN")=PSGORD
"RTN","PSJOE1",39,0)
;RTC 178746 - Don't store allergy here.
"RTN","PSJOE1",40,0)
;D SETOC^PSJNEWOC(PSGORD)
"RTN","PSJOE1",41,0)
I PSGOEAV D G AD
"RTN","PSJOE1",42,0)
. D SETOC^PSJNEWOC(PSGORD) ;RTC 17874
"RTN","PSJOE1",43,0)
.I '$D(PSGOEE),+PSJSYSU=3 D EN^PSGPEN(PSGORD)
"RTN","PSJOE1",44,0)
S PSGOEEF=0 D
GETUD^PSJLMGUD(PSGP,PSGORD),ENSFE^PSGOEE0(PSGP,PSGORD),^PSGOE1,EN^VALM("PSJ LM UD
ACTION")
"RTN","PSJOE1",45,0)
;RTC 178746 - store allergy if not verify the newly created order.
"RTN","PSJOE1",46,0)
I ($G(PSGORD)["P"),($P($G(^PS(53.1,+PSGORD,0)),U,9)="N"),($G(PSJOCFG)="NEW UD") D
SETOC^PSJNEWOC(PSGORD)
"RTN","PSJOE1",47,0)
G AD
"RTN","PSJOE1",48,0)
Q
"RTN","PSJOE1",49,0)
OC ;
"RTN","PSJOE1",50,0)
NEW PSJDD,PSJALLGY,PSJALGY1
"RTN","PSJOE1",51,0)
K PSGORQF
"RTN","PSJOE1",52,0)
D FULL^VALM1
"RTN","PSJOE1",53,0)
S PSJDD=+$$DD53P45^PSJMISC() I 'PSJDD S PSGORQF=1 Q
"RTN","PSJOE1",54,0)
I +$G(PSGEDTOI) D
"RTN","PSJOE1",55,0)
. S PSJALGY1=1
"RTN","PSJOE1",56,0)
. D ENDDC^PSGSICHK($G(PSGP),PSJDD)
"RTN","PSJOE1",57,0)
D:'$G(PSGORQF) IN^PSJOCDS($G(PSGORD),"UD",PSJDD)
"RTN","PSJOE1",58,0)
Q
"RTN","PSJOE1",59,0)
EDIT(PROMPT) ;
"RTN","PSJOE1",60,0)
; Edit fields in a UD order.
"RTN","PSJOE1",61,0)
; PROMPT=0 - Select fields to edit by number.
"RTN","PSJOE1",62,0)
; PROMPT=1 - Prompt to select fields for editing.
"RTN","PSJOE1",63,0)
;
"RTN","PSJOE1",64,0)
;* D @$S('PROMPT:"ENEFA2^PSGON",1:"ENEFA^PSGON") Q:'Y S PSGOEEG=3 D EDIT^PSGOEE
;$S(PSGOEEWF[53.1:3,1:5) D:Y EDIT^PSGOEE
"RTN","PSJOE1",65,0)
D @$S('PROMPT:"ENEFA2^PSGON",1:"ENEFA^PSGON") Q:'Y S:$G(PSJNEWOE) PSGOEEWF="^PS(53.1,"
S PSGOEEG=$S('$D(PSGOEEWF):3,PSGOEEWF[53.1:3,1:5) D EDIT^PSGOEE
"RTN","PSJOE1",66,0)
I $G(PSJNEWOE) S PSGOEENO=0,DR="",VALMBCK="R"
"RTN","PSJOE1",67,0)
I '$G(PSJNEWOE) D ENNOU^PSGOEE0 I 'PSGOEENO,DR="" S VALMBCK="R" Q
"RTN","PSJOE1",68,0)
I 'PSGOEENO,$D(PSGOES) D ENNOU^PSGOEE0 ; only update on order sets
"RTN","PSJOE1",69,0)
;*179 No longer call CKDT^PSGOEE from here.
"RTN","PSJOE1",70,0)
;I 'PSGOEENO,$G(PSGPDNX)=1 D CKDT^PSGOEE
"RTN","PSJOE1",71,0)
I $G(PSGOEER)["101^PSGOE8" S PSGEDTOI=1
"RTN","PSJOE1",72,0)
K VALMSG I PSGOEENO D
"RTN","PSJOE1",73,0)
.S VALMSG="This change will cause a new order to be created." D
GTSTATUS^PSGOEE,CHKDD^PSGOEE,CKDT^PSGOEE ;*373
"RTN","PSJOE1",74,0)
.S
PSGEBN=$$ENNPN^PSGMI(DUZ),PSGLIN=$$ENDD^PSGMI(PSGDT)_U_$$ENDTC^PSGMI(PSGDT),PSGLI=P
SGDT
"RTN","PSJOE1",75,0)
D CHK^PSGOEV("^^"_PSGMR_"^^^^"_PSGST,PSGPDRG_U_PSGDO,PSGSCH_U_PSGSD_"^^"_PSGFD)
"RTN","PSJOE1",76,0)
D INIT^PSJLMUDE(PSGP,$G(PSGORD))
"RTN","PSJOE1",77,0)
Q
"RTN","PSJOE1",78,0)
DONE ;
"RTN","PSJOE1",79,0)
K
%,DA,DIC,DIE,DR,DRG,DRGN,DRGO,ND,OC,ORIFN,ORIT,ORPK,ORSTOP,ORSTRT,ORSTS,ORTX,PC,PSGDO,P
SGMR,PSGMRN,PSGNEDFD,PSGNEFD,PSGNESD,PSGOES,PSGOROE1,PSGORD,PSGS0XT,PSGS0Y,PSGSCH,P
SGSI,PSGX,Y,Z
"RTN","PSJOE1",80,0)
K PSGEDTOI,PSJOCFG,PSGDUR,PSGRMVT,PSGRMV,PSGRF,ND2,ND2P1 ;*315
"RTN","PSJOE1",81,0)
Q
"RTN","PSJOE1",82,0)
;
"RTN","PSJOE1",83,0)
GDO ;
"RTN","PSJOE1",84,0)
W !!,"Drug is not found in Formulary List." F S %=1 W !,"Would you like to try to search the list again" D
YN^DICN Q:% D TAM
"RTN","PSJOE1",85,0)
Q:%<2
"RTN","PSJOE1",86,0)
FTD ;
"RTN","PSJOE1",87,0)
R !!,"Enter FREE TEXT DRUG: ",PSGDRGN:DTIME E W $C(7) S PSGDRGN="^" Q
"RTN","PSJOE1",88,0)
Q:"^"[PSGDRGN S X=$S(PSGDRGN'?.ANP:"Control character(s)",PSGDRGN["^":"Up-arrow ('^') in
text",$L(PSGDRGN)>39:"Response longer than 39 characters",1:"") I X]"" W $C(7)," ??",!?2,"(",X," not
allowed.)" G FTD
"RTN","PSJOE1",89,0)
Q:PSGDRGN'?1."?"
"RTN","PSJOE1",90,0)
W !!?2,"ENTER DRUG ORDERED (1-39 CHARACTERS).",!?2,"Since the drug cannot be found in the DRUG
file, enter the drug name here",!,"exactly as ordered. Press the RETURN key (or enter an '^') to skip over
this",!,"drug, or to again search the"
"RTN","PSJOE1",91,0)
W " DRUG file for this one." G FTD
"RTN","PSJOE1",92,0)
;
"RTN","PSJOE1",93,0)
TAM ; Try Again Message
"RTN","PSJOE1",94,0)
W !!," Enter a 'Y' to try again to find the drug ordered from the Formulary. (The",!,"order cannot
become active until a Formulary drug has been entered.) Enter 'N'",!,"to enter the drug ordered as free
text for later reference."
"RTN","PSJOE1",95,0)
W " Enter '^' to exit.",! Q
"VER")
8.0^22.2
"BLD",10446,6)
1^308
$END KID PSJ*5.0*373