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

KIDS Distribution saved on Mar 29, 2018@17:14:43
PSJ*5*366
**KIDS**:PSJ*5.0*366^

**INSTALL NAME**
PSJ*5.0*366
"BLD",9978,0)
PSJ*5.0*366^INPATIENT MEDICATIONS^0^3180329^y
"BLD",9978,1,0)
^^64^64^3180329^
"BLD",9978,1,1,0)
As part of the Clinical Ancillary Services project (CAS) - Medication
"BLD",9978,1,2,0)
Permission/Dispensing Updates (MPDU), the Inpatient Medications package
"BLD",9978,1,3,0)
has been modified to address the following:
"BLD",9978,1,4,0)

"BLD",9978,1,5,0)
This patch will address the following issues.
"BLD",9978,1,6,0)

"BLD",9978,1,7,0)
1. Limit the Display of Medication Routes for Infusion Order Dialogs
"BLD",9978,1,8,0)
2. Limit the Display of Medication Routes for Inpatient Unit Dose Order
"BLD",9978,1,9,0)
Dialogs
"BLD",9978,1,10,0)

"BLD",9978,1,11,0)
Item 1
"BLD",9978,1,12,0)
------
"BLD",9978,1,13,0)

"BLD",9978,1,14,0)
Problem:
"BLD",9978,1,15,0)
-------
"BLD",9978,1,16,0)

"BLD",9978,1,17,0)
As a pharmacist entering an infusion order in VistA, I want only want
"BLD",9978,1,18,0)
medication routes that are appropriate for use with the medication I
"BLD",9978,1,19,0)
select displayed to prevent me from selecting the incorrect route
"BLD",9978,1,20,0)
subsequently increasing patient safety.
"BLD",9978,1,21,0)
1. When entering an inpatient or outpatient infusion order into VistA, I
"BLD",9978,1,22,0)
only want medication routes associated with the medication dosage form
"BLD",9978,1,23,0)
for the medication selected displayed as available for selection.
"BLD",9978,1,24,0)
2. If I enter medication route, I want the route entered matched to the
"BLD",9978,1,25,0)
available routes as an exact match.
"BLD",9978,1,26,0)
a. If I enter a partial route, I want to the standard FileMan response
"BLD",9978,1,27,0)
of "??" to alert me that an exact match cannot be found.
"BLD",9978,1,28,0)
b. If I enter a complete route, I want that route selected for use with
"BLD",9978,1,29,0)
that medication.
"BLD",9978,1,30,0)

"BLD",9978,1,31,0)

"BLD",9978,1,32,0)
Resolution:
"BLD",9978,1,33,0)
----------
"BLD",9978,1,34,0)
Routine PSIVEDT was modified to allow med routes that are exact matches
"BLD",9978,1,35,0)
only.
"BLD",9978,1,36,0)

"BLD",9978,1,37,0)

"BLD",9978,1,38,0)

"BLD",9978,1,39,0)
Item 2
"BLD",9978,1,40,0)
------
"BLD",9978,1,41,0)
Problem:
"BLD",9978,1,42,0)
-------
"BLD",9978,1,43,0)

"BLD",9978,1,44,0)
As a pharmacist entering an inpatient medication order, I only want
"BLD",9978,1,45,0)
medication routes that are appropriate for use with the medication I
"BLD",9978,1,46,0)
selected, prevent me from selecting the incorrect route subsequently
"BLD",9978,1,47,0)
increasing patient safety.
"BLD",9978,1,48,0)

"BLD",9978,1,49,0)
1. When entering an inpatient medication order in VistA, I only want
"BLD",9978,1,50,0)
medication routes associated with the medication dosage form for the
"BLD",9978,1,51,0)
medication selected displayed as available for selection.
"BLD",9978,1,52,0)
2. If I enter medication route, I want the route entered matched to
"BLD",9978,1,53,0)
the available routes as an exact match.
"BLD",9978,1,54,0)
a. If I enter a partial route, I want to the standard FileMan response
"BLD",9978,1,55,0)
of "??" to alert me that an exact match cannot be found.
"BLD",9978,1,56,0)
b. If I enter a complete route, I want that route selected for use
"BLD",9978,1,57,0)
with that medication.
"BLD",9978,1,58,0)

"BLD",9978,1,59,0)

"BLD",9978,1,60,0)

"BLD",9978,1,61,0)
Resolution:
"BLD",9978,1,62,0)
----------
"BLD",9978,1,63,0)
Routines PSGOE4, PSGOE8 and PSGOE9 were modified to not allow partial med
"BLD",9978,1,64,0)
route and to allow exact matches only.
"BLD",9978,4,0)
^9.64PA^^
"BLD",9978,6.3)
3
"BLD",9978,"KRN",0)
^9.67PA^779.2^20
"BLD",9978,"KRN",.4,0)
.4
"BLD",9978,"KRN",.401,0)
.401
"BLD",9978,"KRN",.402,0)
.402
"BLD",9978,"KRN",.403,0)
.403
"BLD",9978,"KRN",.5,0)
.5
"BLD",9978,"KRN",.84,0)
.84
"BLD",9978,"KRN",3.6,0)
3.6
"BLD",9978,"KRN",3.8,0)
3.8
"BLD",9978,"KRN",9.2,0)
9.2
"BLD",9978,"KRN",9.8,0)
9.8
"BLD",9978,"KRN",9.8,"NM",0)
^9.68A^4^4
"BLD",9978,"KRN",9.8,"NM",1,0)
PSGOE4^^0^B31422935
"BLD",9978,"KRN",9.8,"NM",2,0)
PSGOE8^^0^B53361203
"BLD",9978,"KRN",9.8,"NM",3,0)
PSGOE9^^0^B46590236
"BLD",9978,"KRN",9.8,"NM",4,0)
PSIVEDT^^0^B52942616
"BLD",9978,"KRN",9.8,"NM","B","PSGOE4",1)

"BLD",9978,"KRN",9.8,"NM","B","PSGOE8",2)

"BLD",9978,"KRN",9.8,"NM","B","PSGOE9",3)

"BLD",9978,"KRN",9.8,"NM","B","PSIVEDT",4)

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

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

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

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

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

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

"BLD",9978,"KRN","B",3.6,3.6)

"BLD",9978,"KRN","B",3.8,3.8)

"BLD",9978,"KRN","B",9.2,9.2)

"BLD",9978,"KRN","B",9.8,9.8)

"BLD",9978,"KRN","B",19,19)

"BLD",9978,"KRN","B",19.1,19.1)

"BLD",9978,"KRN","B",101,101)

"BLD",9978,"KRN","B",409.61,409.61)

"BLD",9978,"KRN","B",771,771)

"BLD",9978,"KRN","B",779.2,779.2)

"BLD",9978,"KRN","B",870,870)

"BLD",9978,"KRN","B",8989.51,8989.51)

"BLD",9978,"KRN","B",8989.52,8989.52)

"BLD",9978,"KRN","B",8994,8994)

"BLD",9978,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",9978,"QUES",0)
^9.62^^
"BLD",9978,"REQB",0)
^9.611^3^3
"BLD",9978,"REQB",1,0)
PSJ*5.0*253^2
"BLD",9978,"REQB",2,0)
PSJ*5.0*281^2
"BLD",9978,"REQB",3,0)
PSJ*5.0*352^2
"BLD",9978,"REQB","B","PSJ*5.0*253",1)

"BLD",9978,"REQB","B","PSJ*5.0*281",2)

"BLD",9978,"REQB","B","PSJ*5.0*352",3)

"MBREQ")
0
"PKG",221,-1)
1^1
"PKG",221,0)
INPATIENT MEDICATIONS^PSJ^UNIT DOSE AND IVS
"PKG",221,22,0)
^9.49I^1^1
"PKG",221,22,1,0)
5.0^2971215^2981113^1
"PKG",221,22,1,"PAH",1,0)
366^3180329
"PKG",221,22,1,"PAH",1,1,0)
^^64^64^3180329
"PKG",221,22,1,"PAH",1,1,1,0)
As part of the Clinical Ancillary Services project (CAS) - Medication
"PKG",221,22,1,"PAH",1,1,2,0)
Permission/Dispensing Updates (MPDU), the Inpatient Medications package
"PKG",221,22,1,"PAH",1,1,3,0)
has been modified to address the following:
"PKG",221,22,1,"PAH",1,1,4,0)

"PKG",221,22,1,"PAH",1,1,5,0)
This patch will address the following issues.
"PKG",221,22,1,"PAH",1,1,6,0)

"PKG",221,22,1,"PAH",1,1,7,0)
1. Limit the Display of Medication Routes for Infusion Order Dialogs
"PKG",221,22,1,"PAH",1,1,8,0)
2. Limit the Display of Medication Routes for Inpatient Unit Dose Order
"PKG",221,22,1,"PAH",1,1,9,0)
Dialogs
"PKG",221,22,1,"PAH",1,1,10,0)

"PKG",221,22,1,"PAH",1,1,11,0)
Item 1
"PKG",221,22,1,"PAH",1,1,12,0)
------
"PKG",221,22,1,"PAH",1,1,13,0)

"PKG",221,22,1,"PAH",1,1,14,0)
Problem:
"PKG",221,22,1,"PAH",1,1,15,0)
-------
"PKG",221,22,1,"PAH",1,1,16,0)

"PKG",221,22,1,"PAH",1,1,17,0)
As a pharmacist entering an infusion order in VistA, I want only want
"PKG",221,22,1,"PAH",1,1,18,0)
medication routes that are appropriate for use with the medication I
"PKG",221,22,1,"PAH",1,1,19,0)
select displayed to prevent me from selecting the incorrect route
"PKG",221,22,1,"PAH",1,1,20,0)
subsequently increasing patient safety.
"PKG",221,22,1,"PAH",1,1,21,0)
1. When entering an inpatient or outpatient infusion order into VistA, I
"PKG",221,22,1,"PAH",1,1,22,0)
only want medication routes associated with the medication dosage form
"PKG",221,22,1,"PAH",1,1,23,0)
for the medication selected displayed as available for selection.
"PKG",221,22,1,"PAH",1,1,24,0)
2. If I enter medication route, I want the route entered matched to the
"PKG",221,22,1,"PAH",1,1,25,0)
available routes as an exact match.
"PKG",221,22,1,"PAH",1,1,26,0)
a. If I enter a partial route, I want to the standard FileMan response
"PKG",221,22,1,"PAH",1,1,27,0)
of "??" to alert me that an exact match cannot be found.
"PKG",221,22,1,"PAH",1,1,28,0)
b. If I enter a complete route, I want that route selected for use with
"PKG",221,22,1,"PAH",1,1,29,0)
that medication.
"PKG",221,22,1,"PAH",1,1,30,0)

"PKG",221,22,1,"PAH",1,1,31,0)

"PKG",221,22,1,"PAH",1,1,32,0)
Resolution:
"PKG",221,22,1,"PAH",1,1,33,0)
----------
"PKG",221,22,1,"PAH",1,1,34,0)
Routine PSIVEDT was modified to allow med routes that are exact matches
"PKG",221,22,1,"PAH",1,1,35,0)
only.
"PKG",221,22,1,"PAH",1,1,36,0)

"PKG",221,22,1,"PAH",1,1,37,0)

"PKG",221,22,1,"PAH",1,1,38,0)

"PKG",221,22,1,"PAH",1,1,39,0)
Item 2
"PKG",221,22,1,"PAH",1,1,40,0)
------
"PKG",221,22,1,"PAH",1,1,41,0)
Problem:
"PKG",221,22,1,"PAH",1,1,42,0)
-------
"PKG",221,22,1,"PAH",1,1,43,0)

"PKG",221,22,1,"PAH",1,1,44,0)
As a pharmacist entering an inpatient medication order, I only want
"PKG",221,22,1,"PAH",1,1,45,0)
medication routes that are appropriate for use with the medication I
"PKG",221,22,1,"PAH",1,1,46,0)
selected, prevent me from selecting the incorrect route subsequently
"PKG",221,22,1,"PAH",1,1,47,0)
increasing patient safety.
"PKG",221,22,1,"PAH",1,1,48,0)

"PKG",221,22,1,"PAH",1,1,49,0)
1. When entering an inpatient medication order in VistA, I only want
"PKG",221,22,1,"PAH",1,1,50,0)
medication routes associated with the medication dosage form for the
"PKG",221,22,1,"PAH",1,1,51,0)
medication selected displayed as available for selection.
"PKG",221,22,1,"PAH",1,1,52,0)
2. If I enter medication route, I want the route entered matched to
"PKG",221,22,1,"PAH",1,1,53,0)
the available routes as an exact match.
"PKG",221,22,1,"PAH",1,1,54,0)
a. If I enter a partial route, I want to the standard FileMan response
"PKG",221,22,1,"PAH",1,1,55,0)
of "??" to alert me that an exact match cannot be found.
"PKG",221,22,1,"PAH",1,1,56,0)
b. If I enter a complete route, I want that route selected for use
"PKG",221,22,1,"PAH",1,1,57,0)
with that medication.
"PKG",221,22,1,"PAH",1,1,58,0)

"PKG",221,22,1,"PAH",1,1,59,0)

"PKG",221,22,1,"PAH",1,1,60,0)

"PKG",221,22,1,"PAH",1,1,61,0)
Resolution:
"PKG",221,22,1,"PAH",1,1,62,0)
----------
"PKG",221,22,1,"PAH",1,1,63,0)
Routines PSGOE4, PSGOE8 and PSGOE9 were modified to not allow partial med
"PKG",221,22,1,"PAH",1,1,64,0)
route and to allow exact matches only.
"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")
4
"RTN","PSGOE4")
0^1^B31422935
"RTN","PSGOE4",1,0)
PSGOE4 ;BIR/CML3 - REGULAR ORDER ENTRY ;06 Feb 01 / 4:31 PM
"RTN","PSGOE4",2,0)
;;5.0;INPATIENT MEDICATIONS ;**2,50,64,58,111,113,245,253,366**;16 DEC, 1997;Build 3
"RTN","PSGOE4",3,0)
;
"RTN","PSGOE4",4,0)
; Reference to ^PS(51.2 is supported by DBIA 2178.
"RTN","PSGOE4",5,0)
; Reference to ^PS(51.1 is supported by DBIA 2177.
"RTN","PSGOE4",6,0)
;
"RTN","PSGOE4",7,0)
K PSGOES S PSGMR=$S($P(PSGNEDFD,"^",2):$P(PSGNEDFD,"^",2),1:PSGOEDMR),PSGSCH=$P(PSGNEDFD,"^",4),PSGPR=PSGOEPR,(PSGSD,PSGFD,PSGSM,PSGHSM,PSGUD,PSGSI,PSGOROE1,PSGNEFD,PSGMRN)=""
"RTN","PSGOE4",8,0)
S:PSGMR PSGMRN=$S('$P(PSGNEDFD,"^",2):"ORAL",'$D(^PS(51.2,PSGMR,0)):PSGMR,$P(^(0),"^")]"":$P(^(0),"^"),1:PSGMR) I PSGPR S PSGPRN=$P($G(^VA(200,PSGPR,0)),"^") S:PSGPRN="" PSGPRN=PSGPR
"RTN","PSGOE4",9,0)
S PSGST=$S($P(PSGNEDFD,"^",3)]"":$P(PSGNEDFD,"^",3),1:"C"),PSGSTN=$$ENSTN^PSGMI(PSGST),F1=53.1 K PSGFOK S PSGFOK(2)=""
"RTN","PSGOE4",10,0)
S:$P(PSJSYSU,";",4) PSGFOK(2)="" K ^PS(53.45,PSJSYSP,1),^(2) I PSGDRG S ^(2,0)="^53.4502P^"_PSGDRG_"^1",^(1,0)=PSGDRG,^PS(53.45,PSJSYSP,2,"B",PSGDRG,1)=""
"RTN","PSGOE4",11,0)
;
"RTN","PSGOE4",12,0)
109 ; dosage ordered
"RTN","PSGOE4",13,0)
I $P(PSJSYSU,";",4) D GETDOSE^PSJDOSE(PSGDRG) G:PSGOROE1 DONE G:'$G(PSGOE3) 3
"RTN","PSGOE4",14,0)
W !,"DOSAGE ORDERED: ",$S(PSGDO]"":PSGDO_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
"RTN","PSGOE4",15,0)
I X="" S X=PSGDO ;I X="" W $C(7)," (Required)" G 109
"RTN","PSGOE4",16,0)
S PSGF2=109 I X="@" S PSGDO="" ;W $C(7)," (Required)" G 109
"RTN","PSGOE4",17,0)
I X="@" D DEL G:%'=1 109 S (PSGDO,PSGFOK(109),PSGUD)="" G 3
"RTN","PSGOE4",18,0)
I X?1."?" D ENHLP^PSGOEM(53.1,109) G 109
"RTN","PSGOE4",19,0)
I $E(X)="^" D FF G:Y>0 @Y G 109
"RTN","PSGOE4",20,0)
I $E(X,$L(X))=" " F S X=$E(X,1,$L(X)-1) Q:$E(X,$L(X))'=" "
"RTN","PSGOE4",21,0)
I $S(X="":0,X?.E1C.E:1,$L(X)>20:1,X="":1,X["^":1,X?1.P:1,1:X=+X) W $C(7)," ",$S(X?1.P!(X=""):"(Required)",1:"??") D ENHLP^PSGOEM(53.1,109) G 109
"RTN","PSGOE4",22,0)
S PSGDO=X,PSGFOK(109)=""
"RTN","PSGOE4",23,0)
;
"RTN","PSGOE4",24,0)
13 ; units per dose
"RTN","PSGOE4",25,0)
;/** NO LONGER USE WITH POE
"RTN","PSGOE4",26,0)
Q:$G(PSGOE3)
"RTN","PSGOE4",27,0)
G:'$P(PSJSYSU,";",4) 3 I $D(PSGFOK(13)) S PSGFOK(13)=1 D 2^PSGOE42 S PSGFOK(13)="" G 3
"RTN","PSGOE4",28,0)
;
"RTN","PSGOE4",29,0)
A13 ;
"RTN","PSGOE4",30,0)
W !,"UNITS PER DOSE: ",$S(PSGUD:PSGUD_"// ",1:"") R X:DTIME I X="^"!'$T S PSGOROE1=1 G DONE
"RTN","PSGOE4",31,0)
I X="" W:'PSGUD " (1)" G S13
"RTN","PSGOE4",32,0)
S PSGF2=13 I X="@",'PSGUD W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,13) G A13
"RTN","PSGOE4",33,0)
I X="@" D DEL G:%'=1 13 S PSGUD="" G S13
"RTN","PSGOE4",34,0)
I X?1."?" D ENHLP^PSGOEM(53.1,13) G A13
"RTN","PSGOE4",35,0)
I $E(X)="^" D FF G:Y>0 @Y G A13
"RTN","PSGOE4",36,0)
I X?1.2N1"/"1.2N S X=+$J(+X/$P(X,"/",2),0,2) W " ("_$E("0",X<1)_X_")"
"RTN","PSGOE4",37,0)
I $S($L(X)>12:1,X'=+X:1,X>50:1,X<0:1,1:X?.N1"."3.N) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,13) G 13
"RTN","PSGOE4",38,0)
S PSGUD=X W:'X " (1)"
"RTN","PSGOE4",39,0)
;
"RTN","PSGOE4",40,0)
S13 ;
"RTN","PSGOE4",41,0)
S PSGFOK(13)="" I PSGDRG S $P(^PS(53.45,PSJSYSP,2,1,0),"^",2)=PSGUD
"RTN","PSGOE4",42,0)
;
"RTN","PSGOE4",43,0)
3 ; med route
"RTN","PSGOE4",44,0)
W !,"MED ROUTE: ",$S(PSGMR:PSGMRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
"RTN","PSGOE4",45,0)
I X="",PSGMR S X=PSGMRN I PSGMR'=PSGMRN,$D(^PS(51.2,PSGMR,0)) W " "_$P(^(0),"^",3) S PSGFOK(3)=""
"RTN","PSGOE4",46,0)
S PSGF2=3 I $S(X="@":1,X]"":0,1:'PSGMR) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,2) G 3
"RTN","PSGOE4",47,0)
I X?1."?" D ENHLP^PSGOEM(53.1,3)
"RTN","PSGOE4",48,0)
I $E(X)="^" D FF G:Y>0 @Y G 3
"RTN","PSGOE4",49,0)
K DIC S DIC="^PS(51.2,",DIC(0)="EMQZX",DIC("S")="I $P(^(0),""^"",4)" D ^DIC K DIC I Y'>0 G 3 ;366
"RTN","PSGOE4",50,0)
S PSGMR=+Y,PSGMRN=$P(Y(0),"^") S PSGFOK(3)=""
"RTN","PSGOE4",51,0)
Q:$G(PSGOE3)
"RTN","PSGOE4",52,0)
;
"RTN","PSGOE4",53,0)
26 ; schedule
"RTN","PSGOE4",54,0)
W !,"SCHEDULE: ",$S(PSGSCH]"":PSGSCH_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
"RTN","PSGOE4",55,0)
S PSGF2=26 S:X="" X=PSGSCH,PSGSCH="" I "@"[X W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,26) G 26
"RTN","PSGOE4",56,0)
I X?1."?" D ENHLP^PSGOEM(53.1,26) G 26
"RTN","PSGOE4",57,0)
I $E(X)="^" D FF G:Y>0 @Y G 26
"RTN","PSGOE4",58,0)
S DOW=0 I $$DOW^PSIVUTL(X) S DOW=1,PSGST="C",PSGSTN=$$ENSTN^PSGMI(PSGST),PSGS0Y=$P(X,"@",2)
"RTN","PSGOE4",59,0)
N PSJSLUP S PSJSLUP=1 D EN^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,26) G 26
"RTN","PSGOE4",60,0)
I PSGSCH[" PRN",$$PRNOK^PSGS0(PSGSCH) S PSGST="P",PSGSTN=$$ENSTN^PSGMI(PSGST)
"RTN","PSGOE4",61,0)
S PSGSCH=X,$P(PSGNEDFD,"^",4)=X,PSGFOK(26)="" I PSGS0XT="O" S $P(PSGNEDFD,"^",3)="O",PSGST="O",PSGSTN=$$ENSTN^PSGMI(PSGST)
"RTN","PSGOE4",62,0)
I $G(PSGOE3) D Q
"RTN","PSGOE4",63,0)
. S PSGSCH=X,PSGST=$S($G(DOW):"C",PSGS0XT="O":"O",PSGST="R":"R",X["PRN":"P",X="ON CALL":"OC",PSGST]"":PSGST,1:"C"),PSGFOK(26)=""
"RTN","PSGOE4",64,0)
. S $P(PSGNEDFD,"^",3)=PSGST S:PSGSCH=""!(X?1." ") PSGSCH="PRN"
"RTN","PSGOE4",65,0)
. S PSGSTN=$$ENSTN^PSGMI(PSGST)
"RTN","PSGOE4",66,0)
K DOW
"RTN","PSGOE4",67,0)
;
"RTN","PSGOE4",68,0)
7 ; schedule type
"RTN","PSGOE4",69,0)
Q:$G(PSGOE3)
"RTN","PSGOE4",70,0)
D ;Default Schedule Type from Schedule file - PSJ*5*113 - DRF
"RTN","PSGOE4",71,0)
. N XX
"RTN","PSGOE4",72,0)
. I $$DOW^PSIVUTL(PSGSCH) S PSGST="C",PSGSTN=$$ENSTN^PSGMI(PSGST) Q
"RTN","PSGOE4",73,0)
. I PSGSCH[" PRN",$$PRNOK^PSGS0(PSGSCH) S PSGST="P",PSGSTN=$$ENSTN^PSGMI(PSGST) Q
"RTN","PSGOE4",74,0)
. I PSGSCH]"" D
"RTN","PSGOE4",75,0)
.. S XX=+$O(^PS(51.1,"AC","PSJ",PSGSCH,0))
"RTN","PSGOE4",76,0)
.. S PSGST=$P($G(^PS(51.1,XX,0)),"^",5) I PSGST="D" S PSGST="C"
"RTN","PSGOE4",77,0)
.. S PSGSTN=$$ENSTN^PSGMI(PSGST)
"RTN","PSGOE4",78,0)
W !,"SCHEDULE TYPE: "_$S(PSGSTN]"":PSGSTN_"// ",1:"") R X:DTIME S X=$TR(X,"coprocf","COPROCF") I X="^"!'$T S PSGOROE1=1 W $C(7) G DONE
"RTN","PSGOE4",79,0)
I X="" S:PSGST="OC" PSGSCH=PSGSTN,(PSGS0Y,PSGS0XT)="" W " "_PSGSTN S PSGFOK(7)="" S $P(PSGNEDFD,"^",3)=PSGST G ^PSGOE41
"RTN","PSGOE4",80,0)
S PSGF2=7 I X="@"!(X?1."?") W:X="@" $C(7)," ?? (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,7) G 7
"RTN","PSGOE4",81,0)
I $E(X)="^" D FF G:Y>0 @Y G 7
"RTN","PSGOE4",82,0)
S:X="F" X="R" S X=$S(X="PRN":"P",X="ON CALL":"OC",X="FILL on REQUEST":"R",1:X)
"RTN","PSGOE4",83,0)
I ",OC,P,R,"[(","_X_",") S PSGST=X,$P(PSGNEDFD,"^",3)=X,PSGSTN=$S(X="P":"PRN",X="R":"FILL ON REQUEST",1:"ON CALL") W " "_PSGSTN S PSGFOK(7)="" G:X="R" 8^PSGOE41 S (PSGS0Y,PSGS0XT)="" G 8^PSGOE41
"RTN","PSGOE4",84,0)
F Y="C^CONTINUOUS","O^ONE TIME","OC^ON CALL","P^PRN","R^FILL on REQUEST" I $P($P(Y,"^",2),X)="" W $P($P(Y,"^",2),X,2) S PSGST=$P(Y,"^"),PSGSTN=$P(Y,"^",2),$P(PSGNEDFD,"^",3)=PSGST Q
"RTN","PSGOE4",85,0)
E W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,7) G 7
"RTN","PSGOE4",86,0)
I PSGST="R" S PSGFOK(7)="" G 8^PSGOE41
"RTN","PSGOE4",87,0)
S PSGFOK(7)=""
"RTN","PSGOE4",88,0)
;
"RTN","PSGOE4",89,0)
G ^PSGOE41
"RTN","PSGOE4",90,0)
;
"RTN","PSGOE4",91,0)
DONE ;
"RTN","PSGOE4",92,0)
I PSGOROE1 K Y W $C(7)," ...order not entered..."
"RTN","PSGOE4",93,0)
K F,F0,F1,PSGF2,F3,PSG,PSGSD,SDT Q
"RTN","PSGOE4",94,0)
;
"RTN","PSGOE4",95,0)
FF ; up-arrow to another field
"RTN","PSGOE4",96,0)
D ENFF^PSGOEM I Y>0,Y'=109,Y'=13,Y'=3,Y'=7,Y'=26 S:Y=2 FB=PSGF2_"^PSGOE4" S Y=Y_"^PSGOE4"_$S("^39^8^10^25^"[("^"_Y_"^"):1,1:2)
"RTN","PSGOE4",97,0)
Q
"RTN","PSGOE4",98,0)
;
"RTN","PSGOE4",99,0)
DEL ; delete entry
"RTN","PSGOE4",100,0)
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
"RTN","PSGOE4",101,0)
Q
"RTN","PSGOE8")
0^2^B53361203
"RTN","PSGOE8",1,0)
PSGOE8 ;BIR/CML3 - EDIT ORDERS IN 53.1 ; 7/6/11 9:44am
"RTN","PSGOE8",2,0)
;;5.0;INPATIENT MEDICATIONS ;**47,50,65,72,110,111,188,192,113,223,269,287,315,338,366**;16 DEC 97;Build 3
"RTN","PSGOE8",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","PSGOE8",4,0)
; Reference to ^PS(50.7 is supported by DBIA# 2180
"RTN","PSGOE8",5,0)
; Reference to ^PS(51.1 is supported by DBIA 2177
"RTN","PSGOE8",6,0)
; Reference to ^PS(51.2 is supported by DBIA# 2178
"RTN","PSGOE8",7,0)
; Reference to ^PSDRUG is supported by DBIA# 2192
"RTN","PSGOE8",8,0)
;
"RTN","PSGOE8",9,0)
101 ;Orderable Item
"RTN","PSGOE8",10,0)
S MSG=0,F2=101,PSGOOPD=PSGPD,PSGOOPDN=PSGPDN S:PSGOEEF(F2) BACK="101^PSGOE8"
"RTN","PSGOE8",11,0)
S %=1 I $P(PSJSYSU,";",3)>1 W !!,$C(7),"WARNING! If you change the drug of an order, the Dosage Ordered and Dispense",!,"Drug(s) are deleted." F W !,"Do you wish to continue" S %=2 D YN^DICN Q:%
"RTN","PSGOE8",12,0)
I %'=1 G DONE
"RTN","PSGOE8",13,0)
A101 ;
"RTN","PSGOE8",14,0)
I $$PNDREN($G(PSGORD)) D Q
"RTN","PSGOE8",15,0)
. W !!?5,"Orderable Item may not be edited at this point." D PAUSE^VALM1
"RTN","PSGOE8",16,0)
W !,"ORDERABLE ITEM: ",$S(PSGPD:PSGPDN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
"RTN","PSGOE8",17,0)
I X="",PSGPD S X=PSGPDN I PSGPD'=PSGPDN,$D(^PS(50.7,PSGPD,0)) G DONE
"RTN","PSGOE8",18,0)
I $S(X="@":1,X]"":0,1:'PSGPD) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,101) G A101
"RTN","PSGOE8",19,0)
I X?1."?" D ENHLP^PSGOEM(53.1,101)
"RTN","PSGOE8",20,0)
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A101
"RTN","PSGOE8",21,0)
;BHW;PSJ*5.0*192;Modify ^DIC call to use MIX^DIC and only B/C cross-references
"RTN","PSGOE8",22,0)
K DIC,D S DIC="^PS(50.7,",DIC(0)="EMQZ",DIC("S")="I $$ENOISC^PSJUTL(Y,""U"")",D="B^C" D MIX^DIC1 K DIC,D I Y'>0 G A101
"RTN","PSGOE8",23,0)
F S %=2 D DH,YN^DICN Q:%
"RTN","PSGOE8",24,0)
I %'=1 G A101
"RTN","PSGOE8",25,0)
S (PSGPDRG,PSGPD)=+Y,(PSGPDN,PSGPDRGN)=$$OINAME^PSJLMUTL(PSGPDRG)
"RTN","PSGOE8",26,0)
S PSGNEDFD=$$GTNEDFD^PSGOE7("U",PSGPDRG)
"RTN","PSGOE8",27,0)
S PSGPDNX=1,PSGDO="",(PSGPDRG,PSGPD)=+Y,(PSGPDN,PSGPDRGN)=$$OINAME^PSJLMUTL(PSGPDRG) K ^PS(53.45,PSJSYSP,2) S X=$O(^PSDRUG("ASP",PSGPD,0)) I X,'$O(^(X)) D
"RTN","PSGOE8",28,0)
.S ^PS(53.45,PSJSYSP,2,0)="^53.4502P^1^1",^(1,0)=X,^PS(53.45,PSJSYSP,2,"B",X,1)=""
"RTN","PSGOE8",29,0)
D ENDRG^PSGOEF1(PSGPD,0)
"RTN","PSGOE8",30,0)
I $S($D(DTOUT):1,$D(DUOUT):1,$D(DIRUT):1,1:0) G DONE
"RTN","PSGOE8",31,0)
;G DONE
"RTN","PSGOE8",32,0)
;
"RTN","PSGOE8",33,0)
109 ; dosage ordered
"RTN","PSGOE8",34,0)
S MSG=0,F2=109 S:$G(PSGOEEF(F2)) BACK="109^PSGOE8"
"RTN","PSGOE8",35,0)
A109 ;
"RTN","PSGOE8",36,0)
I $$PNDREN($G(PSGORD)) D Q
"RTN","PSGOE8",37,0)
. W !!?5,"Dosage may not be edited at this point." D PAUSE^VALM1
"RTN","PSGOE8",38,0)
S PSGOEEF(F2)=PSGOEE
"RTN","PSGOE8",39,0)
D EDITDOSE^PSJDOSE S X=PSGDO S:X="" PSGDREQ=1 G DONE
"RTN","PSGOE8",40,0)
W !,"DOSAGE ORDERED: ",$S(PSGDO]"":PSGDO_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
"RTN","PSGOE8",41,0)
I X=""&(PSGDO]"") S X=PSGDO
"RTN","PSGOE8",42,0)
I $$CHECK(PSJSYSP)&(X="")&(PSGDO']"") W $C(7)," (Required) " G A109
"RTN","PSGOE8",43,0)
I $$CHECK(PSJSYSP)&(X="@") W $C(7)," (Required) " G A109
"RTN","PSGOE8",44,0)
I '$$CHECK(PSJSYSP)&(X="@") S PSGDO="" G DONE
"RTN","PSGOE8",45,0)
I X?1."?" D ENHLP^PSGOEM(53.1,109) G A109
"RTN","PSGOE8",46,0)
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A109
"RTN","PSGOE8",47,0)
I $E(X,$L(X))=" " F S X=$E(X,1,$L(X)-1) Q:$E(X,$L(X))'=" "
"RTN","PSGOE8",48,0)
I $S(X?.E1C.E:1,$L(X)>20:1,X="":0,X["^":1,X?1.P:1,1:X=+X) W $C(7)," ",$S(X?1.P!(X=""):"(Required)",1:"??") D ENHLP^PSGOEM(53.1,109) G A109
"RTN","PSGOE8",49,0)
S PSGDO=X G DONE
"RTN","PSGOE8",50,0)
;
"RTN","PSGOE8",51,0)
3 ; med route
"RTN","PSGOE8",52,0)
S MSG=0,F2=3 S:PSGOEEF(F2) BACK="3^PSGOE8"
"RTN","PSGOE8",53,0)
A3 I $$PNDREN($G(PSGORD)) D Q
"RTN","PSGOE8",54,0)
. W !!?5,"Med Route may not be edited at this point." D PAUSE^VALM1
"RTN","PSGOE8",55,0)
W !,"MED ROUTE: ",$S(PSGMR:PSGMRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
"RTN","PSGOE8",56,0)
I X="",PSGMR S X=PSGMRN I PSGMR'=PSGMRN,$D(^PS(51.2,PSGMR,0)) W " "_$P(^(0),"^",3) G DONE
"RTN","PSGOE8",57,0)
I $S(X="@":1,X]"":0,1:'PSGMR) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,3) G A3
"RTN","PSGOE8",58,0)
I X?1."?" D ENHLP^PSGOEM(53.1,3)
"RTN","PSGOE8",59,0)
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A3
"RTN","PSGOE8",60,0)
K DIC S DIC="^PS(51.2,",DIC(0)="EMQZX",DIC("S")="I $P(^(0),""^"",4)" D ^DIC K DIC I Y'>0 G A3 ;*366
"RTN","PSGOE8",61,0)
S PSGMR=+Y,PSGMRN=Y(0,0) G DONE
"RTN","PSGOE8",62,0)
;
"RTN","PSGOE8",63,0)
26 ; schedule
"RTN","PSGOE8",64,0)
S MSG=0,F2=26 S:PSGOEEF(F2) BACK="26^PSGOE8"
"RTN","PSGOE8",65,0)
A26 I $$PNDREN($G(PSGORD)) D Q
"RTN","PSGOE8",66,0)
. W !!?5,"Schedule may not be edited at this point." D PAUSE^VALM1
"RTN","PSGOE8",67,0)
W !,"SCHEDULE: ",$S(PSGSCH]"":PSGSCH_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
"RTN","PSGOE8",68,0)
S:X="" X=PSGSCH,PSGSCH="" I "@"[X W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,26) G A26
"RTN","PSGOE8",69,0)
S DOW=0 I $$DOW^PSIVUTL($$ENLU^PSGMI(X)) S DOW=1
"RTN","PSGOE8",70,0)
I X?1."?" D ENHLP^PSGOEM(53.1,26) G A26
"RTN","PSGOE8",71,0)
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A26
"RTN","PSGOE8",72,0)
;BHW;PSJ*5*188;Add flag and IEN return variable for PSGS0 (PSJ*5*134), Highlight Admin Times if they changed.
"RTN","PSGOE8",73,0)
N PSGOES,PSJSLUP,PSGSFLG S PSJSLUP=1,PSGSFLG=1 D EN^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,26) G A26
"RTN","PSGOE8",74,0)
I X'=PSGSCH D
"RTN","PSGOE8",75,0)
. K PSGDUR,PSGRMVT,PSGRMV,ND2P1 ;*315 Removal times are tied to ADMIN times.
"RTN","PSGOE8",76,0)
. N XX
"RTN","PSGOE8",77,0)
. S PSGSCH=X
"RTN","PSGOE8",78,0)
. I PSGS0Y'=PSGAT S PSGAT=PSGS0Y ;Change so that any schedule change will adjust the type and default the admin times - DRF
"RTN","PSGOE8",79,0)
. D ;Change schedule type to agree with schedule
"RTN","PSGOE8",80,0)
.. I $G(DOW) S PSGST="C",PSGSTN=$$ENSTN^PSGMI(PSGST) Q
"RTN","PSGOE8",81,0)
.. I (PSGSCH[" PRN")!(PSGSCH="PRN") I $$PRNOK^PSGS0(PSGSCH) S PSGOST=PSGST,PSGST="P",PSGSTN=$$ENSTN^PSGMI(PSGST) Q
"RTN","PSGOE8",82,0)
.. I '$G(PSGSCIEN),PSGSCH]"" S XX=+$O(^PS(51.1,"AC","PSJ",PSGSCH,0)),PSGSCIEN=XX
"RTN","PSGOE8",83,0)
.. S PSGOST=$G(PSGST),PSGST=$P($G(^PS(51.1,PSGSCIEN,0)),"^",5) I PSGST="D" S PSGST="C" ;DOW schedules are converted to Continuous
"RTN","PSGOE8",84,0)
.. S PSGSTN=$$ENSTN^PSGMI(PSGST)
"RTN","PSGOE8",85,0)
. I $G(PSJSYSW0),($P(PSJSYSW0,U,5)'=2),'$G(PSGEFN(8)) W !!,"NOTE: This may cause the Admin Times and the Start Time to be out of sync."
"RTN","PSGOE8",86,0)
. W !!,"NOTE: This change in schedule also changes the ADMIN TIMES and SCHEDULE TYPE.",!
"RTN","PSGOE8",87,0)
. S MSG=1 S:'$G(PSGOEEF(39)) PSGOEEF(39)=1 ;*287 - Prevent infinite loop editing admin times
"RTN","PSGOE8",88,0)
. I ($G(PSGRF)>1),PSGST="C" D
"RTN","PSGOE8",89,0)
..S PSGF2=39,BACK="39^PSGOE81" D 39^PSGOE81 S BACK="26^PSGOE8",PSGF2=26,PSGOAT=PSGAT ;*315 Prompt for Admin to get DOA
"RTN","PSGOE8",90,0)
..Q
"RTN","PSGOE8",91,0)
. I $G(PSJNEWOE) D PAUSE^VALM1
"RTN","PSGOE8",92,0)
I PSGST="O" S PSGOEEF(7)=1 I +$G(PSGRF) S PSGOEEF(25)=1 D 25^PSGOE81 S PSGF2=26
"RTN","PSGOE8",93,0)
G DONE
"RTN","PSGOE8",94,0)
;
"RTN","PSGOE8",95,0)
7 ; schedule type
"RTN","PSGOE8",96,0)
S MSG=0,F2=7 S:PSGOEEF(F2) BACK="7^PSGOE8"
"RTN","PSGOE8",97,0)
A7 W !,"SCHEDULE TYPE: "_$S(PSGSTN]"":PSGSTN_"// ",1:"") R X:DTIME S X=$TR(X,"coprocf","COPROCF") I X="^"!'$T S PSGOEE=0 W $C(7) G DONE
"RTN","PSGOE8",98,0)
I X="" S X=PSGST,PSGSTN=$$ENSTN^PSGMI(X) W:PSGSTN]"" " ",PSGSTN G DONE
"RTN","PSGOE8",99,0)
S:X="F" X="R"
"RTN","PSGOE8",100,0)
I ",?,??,C,O,OC,P,R,"'[(","_X_",") W " ??" G A7
"RTN","PSGOE8",101,0)
I $$PRNOK^PSGS0($G(PSGSCH)),X="C" W " ??" G A7
"RTN","PSGOE8",102,0)
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,7) G A7
"RTN","PSGOE8",103,0)
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A7
"RTN","PSGOE8",104,0)
;*223 Don't allow O sched type on C orders
"RTN","PSGOE8",105,0)
I X="O",$$SCHTP(PSGSCH)'="O" W !," SCHEDULE ("_PSGSCH_") is not a ONE TIME Schedule." G A7
"RTN","PSGOE8",106,0)
;*269 Don't allow C sched type on O orders
"RTN","PSGOE8",107,0)
I X="C",$$SCHTP(PSGSCH)="O" W !," SCHEDULE ("_PSGSCH_") is not a CONTINUOUS Schedule." G A7
"RTN","PSGOE8",108,0)
S PSGOST=PSGST
"RTN","PSGOE8",109,0)
S PSGST=X,PSGSTN=$$ENSTN^PSGMI(X) W:PSGSTN]"" " ",PSGSTN
"RTN","PSGOE8",110,0)
I X="P",$G(PSGAT)]"" S PSGOAT=PSGAT S PSGAT="" D
"RTN","PSGOE8",111,0)
.W !!,"NOTE: This change in schedule type also changes the ADMIN TIMES.",!
"RTN","PSGOE8",112,0)
.S MSG=1,PSGOEEF(39)=1
"RTN","PSGOE8",113,0)
.I $G(PSJNEWOE) D PAUSE^VALM1
"RTN","PSGOE8",114,0)
;
"RTN","PSGOE8",115,0)
DONE ;
"RTN","PSGOE8",116,0)
I PSGOEE G:'PSGOEEF(F2) @BACK S PSGOEE=PSGOEEF(F2)
"RTN","PSGOE8",117,0)
K F,F0,F2 Q
"RTN","PSGOE8",118,0)
;
"RTN","PSGOE8",119,0)
DEL ; delete entry
"RTN","PSGOE8",120,0)
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
"RTN","PSGOE8",121,0)
Q
"RTN","PSGOE8",122,0)
;
"RTN","PSGOE8",123,0)
DH ;
"RTN","PSGOE8",124,0)
W !!?2,"When the drug of an order is changed, the Dosage Ordered and Dispense Drug(s)",!,"for the order are no longer valid, and therefore deleted from the order.",!,"If possible, a new corresponding dispense drug will be added to the order."
"RTN","PSGOE8",125,0)
W !!?2,"Answer 'YES' to continue with this change. Answer 'NO' to select another",!,"drug or to accept the drug as it was. Enter an '^' to exit this edit." Q
"RTN","PSGOE8",126,0)
;
"RTN","PSGOE8",127,0)
CHECK(PSJSYSP) ; Check to see if multiple dispense drugs
"RTN","PSGOE8",128,0)
; Input - PSJSYSP
"RTN","PSGOE8",129,0)
; Returns 0 = only one.
"RTN","PSGOE8",130,0)
; 1 = more than one
"RTN","PSGOE8",131,0)
; Checks Inactive Date and doesn't count if < or = today.
"RTN","PSGOE8",132,0)
N PSJRSB,PSJINACT,PSJRBCNT S PSJRBCNT=0
"RTN","PSGOE8",133,0)
F PSJRSB=0:0 S PSJRSB=$O(^PS(53.45,PSJSYSP,2,PSJRSB)) Q:'PSJRSB D
"RTN","PSGOE8",134,0)
.S PSJINACT=$P(^PS(53.45,PSJSYSP,2,PSJRSB,0),"^",3)
"RTN","PSGOE8",135,0)
.I (PSJINACT="")!((PSJINACT>0)&(PSJINACT>DT)) D
"RTN","PSGOE8",136,0)
..S PSJRBCNT=$S('$D(PSJRBCNT):1,1:PSJRBCNT+1)
"RTN","PSGOE8",137,0)
Q $S(PSJRBCNT>1:1,1:0)
"RTN","PSGOE8",138,0)
;
"RTN","PSGOE8",139,0)
PNDREN(PNDON) ;
"RTN","PSGOE8",140,0)
I PNDON'["P" Q 0
"RTN","PSGOE8",141,0)
S RNWL="^PS(53.1,"_+PNDON_",0)" S RNWL=$G(@(RNWL)) S RNWL=$S($P(RNWL,"^",24)="R":1,1:0)
"RTN","PSGOE8",142,0)
Q RNWL
"RTN","PSGOE8",143,0)
;
"RTN","PSGOE8",144,0)
SCHTP(SCH) ; *223 Return SCHedule type
"RTN","PSGOE8",145,0)
N X I SCH="" Q ""
"RTN","PSGOE8",146,0)
S X=$O(^PS(51.1,"APPSJ",SCH,0))
"RTN","PSGOE8",147,0)
Q:'$G(X) ""
"RTN","PSGOE8",148,0)
Q $P(^PS(51.1,X,0),"^",5)
"RTN","PSGOE8",149,0)
;
"RTN","PSGOE9")
0^3^B46590236
"RTN","PSGOE9",1,0)
PSGOE9 ;BIR/CML3 - EDIT ORDERS IN 55 ; 7/6/11 9:45am
"RTN","PSGOE9",2,0)
;;5.0;INPATIENT MEDICATIONS ;**11,47,50,72,110,111,188,192,207,113,223,269,315,338,352.366**;16 DEC 97;Build 3
"RTN","PSGOE9",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","PSGOE9",4,0)
; Reference to ^PS(50.7 is supported by DBIA# 2180
"RTN","PSGOE9",5,0)
; Reference to ^PS(51.1 is supported by DBIA 2177
"RTN","PSGOE9",6,0)
; Reference to ^PS(51.2 is supported by DBIA# 2178
"RTN","PSGOE9",7,0)
; Reference to ^PS(55 is supported by DBIA #2191
"RTN","PSGOE9",8,0)
; Reference to ^PSDRUG is supported by DBIA# 2192
"RTN","PSGOE9",9,0)
;
"RTN","PSGOE9",10,0)
101 ; Orderable Item (AKA primary drug)
"RTN","PSGOE9",11,0)
S MSG=0,PSGF2=101,PSGOOPD=PSGPD,PSGOOPDN=PSGPDN S:PSGOEEF(PSGF2) BACK="101^PSGOE9"
"RTN","PSGOE9",12,0)
I $G(PSGOROE1)'=1 S %=1 W !!,$C(7),"WARNING! If you change the drug of an order, the Dosage Ordered and Dispense",!,"Drug(s) are deleted." F W !,"Do you wish to continue" S %=2 D YN^DICN Q:% D DH^PSGOE8
"RTN","PSGOE9",13,0)
I %'=1 G DONE
"RTN","PSGOE9",14,0)
A101 ;
"RTN","PSGOE9",15,0)
I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
"RTN","PSGOE9",16,0)
. W !!?5,"Orderable Item may not be edited for active complex orders." D PAUSE^VALM1
"RTN","PSGOE9",17,0)
W !,"ORDERABLE ITEM: ",$S(PSGPD:PSGPDN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
"RTN","PSGOE9",18,0)
I X="",PSGPD S X=PSGPDN I PSGPD'=PSGPDN,$D(^PS(50.7,PSGPD,0)) G DONE
"RTN","PSGOE9",19,0)
I $S(X="@":1,X]"":0,1:'PSGPD) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,101) G A101
"RTN","PSGOE9",20,0)
I X?1."?" D ENHLP^PSGOEM(55.06,101)
"RTN","PSGOE9",21,0)
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A101
"RTN","PSGOE9",22,0)
;BHW;PSJ*5.0*192;Modify ^DIC call to use MIX^DIC and only B/C cross-references
"RTN","PSGOE9",23,0)
K DIC,D S DIC="^PS(50.7,",DIC(0)="EMQZ",DIC("S")="I $$ENOISC^PSJUTL(Y,""U"")",D="B^C" D MIX^DIC1 K DIC,D I Y'>0 G A101
"RTN","PSGOE9",24,0)
I +Y=PSGPD G DONE ;PSJ*5*269 - No change to Orderable Item
"RTN","PSGOE9",25,0)
F S %=2 D DH^PSGOE8,YN^DICN Q:%
"RTN","PSGOE9",26,0)
I %'=1 G A101
"RTN","PSGOE9",27,0)
S (PSGPDRG,PSGPD)=+Y,(PSGPDN,PSGPDRGN)=$$OINAME^PSJLMUTL(PSGPDRG)
"RTN","PSGOE9",28,0)
S PSGNEDFD=$$GTNEDFD^PSGOE7("U",PSGPDRG)
"RTN","PSGOE9",29,0)
S PSGPDNX=1,PSGPD=+Y,PSGPDN=$$OINAME^PSJLMUTL(PSGPD),PSGDO="" K ^PS(53.45,PSJSYSP,2) S X=$O(^PSDRUG("ASP",PSGPD,0)) I X,'$O(^(X)) S ^PS(53.45,PSJSYSP,2,0)="^53.4502P^1^1",^(1,0)=X,^PS(53.45,PSJSYSP,2,"B",X,1)="" G DONE
"RTN","PSGOE9",30,0)
D ENDRG^PSGOEF1(PSGPD,0)
"RTN","PSGOE9",31,0)
I $S($D(DTOUT):1,$D(DUOUT):1,$D(DIRUT):1,1:0) S PSGOROE1=1 G DONE
"RTN","PSGOE9",32,0)
;G DONE
"RTN","PSGOE9",33,0)
;
"RTN","PSGOE9",34,0)
109 ; dosage ordered
"RTN","PSGOE9",35,0)
S MSG=0,PSGF2=109 S:$G(PSGOEEF(PSGF2)) BACK="109^PSGOE9"
"RTN","PSGOE9",36,0)
A109 ;
"RTN","PSGOE9",37,0)
I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
"RTN","PSGOE9",38,0)
. W !!?5,"Dosage may not be edited for active complex orders." D PAUSE^VALM1
"RTN","PSGOE9",39,0)
D EDITDOSE^PSJDOSE S X=PSGDO G DONE
"RTN","PSGOE9",40,0)
W !,"DOSAGE ORDERED: ",$S(PSGDO]"":PSGDO_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
"RTN","PSGOE9",41,0)
I X=""&(PSGDO]"") S X=PSGDO
"RTN","PSGOE9",42,0)
I $$CHECK^PSGOE8(PSJSYSP)&(X="")&(PSGDO']"") W $C(7)," (Required) " G A109
"RTN","PSGOE9",43,0)
I $$CHECK^PSGOE8(PSJSYSP)&(X="@") W $C(7)," (Required)" G A109
"RTN","PSGOE9",44,0)
I '$$CHECK^PSGOE8(PSJSYSP)&(X="@") S PSGDO="" G DONE
"RTN","PSGOE9",45,0)
I X?1."?" D ENHLP^PSGOEM(55.06,109) G A109
"RTN","PSGOE9",46,0)
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A109
"RTN","PSGOE9",47,0)
I $E(X,$L(X))=" " F S X=$E(X,1,$L(X)-1) Q:$E(X,$L(X))'=" "
"RTN","PSGOE9",48,0)
I $S(X?.E1C.E:1,$L(X)>20:1,X="":0,X["^":1,X?1.P:1,1:X=+X) W $C(7)," ",$S(X?1.P!(X=""):"(Required)",1:"??") D ENHLP^PSGOEM(55.06,109) G A109
"RTN","PSGOE9",49,0)
S PSGDO=X G DONE
"RTN","PSGOE9",50,0)
;
"RTN","PSGOE9",51,0)
3 ; med route
"RTN","PSGOE9",52,0)
S MSG=0,PSGF2=3 S:PSGOEEF(PSGF2) BACK="3^PSGOE9"
"RTN","PSGOE9",53,0)
A3 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
"RTN","PSGOE9",54,0)
. W !!?5,"Med Route may not be edited for active complex orders." D PAUSE^VALM1
"RTN","PSGOE9",55,0)
W !,"MED ROUTE: ",$S(PSGMR:PSGMRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
"RTN","PSGOE9",56,0)
I X="",PSGMR S X=PSGMRN I PSGMR'=PSGMRN,$D(^PS(51.2,PSGMR,0)) W " "_$P(^(0),"^",3) G DONE
"RTN","PSGOE9",57,0)
I $S(X="@":1,X]"":0,1:'PSGMR) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,3) G A3
"RTN","PSGOE9",58,0)
I X?1."?" D ENHLP^PSGOEM(55.06,3)
"RTN","PSGOE9",59,0)
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A3
"RTN","PSGOE9",60,0)
K DIC S DIC="^PS(51.2,",DIC(0)="EMQZX",DIC("S")="I $P(^(0),""^"",4)" D ^DIC K DIC I Y'>0 G A3
"RTN","PSGOE9",61,0)
S PSGMR=+Y,PSGMRN=Y(0,0) G DONE
"RTN","PSGOE9",62,0)
;
"RTN","PSGOE9",63,0)
7 ; schedule type
"RTN","PSGOE9",64,0)
S MSG=0,PSGF2=7 S:PSGOEEF(PSGF2) BACK="7^PSGOE9"
"RTN","PSGOE9",65,0)
A7 I $G(PSGP),$G(PSGORD) I $$COMPLEX^PSJOE(PSGP,PSGORD) D
"RTN","PSGOE9",66,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","PSGOE9",67,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","PSGOE9",68,0)
W !,"SCHEDULE TYPE: "_$S(PSGSTN]"":PSGSTN_"// ",1:"") R X:DTIME S X=$TR(X,"coprocf","COPROCF") I X="^"!'$T S PSGOEE=0 W $C(7) G DONE
"RTN","PSGOE9",69,0)
I X="" S X=PSGST,PSGSTN=$$ENSTN^PSGMI(X) W:PSGSTN]"" " ",PSGSTN G DONE
"RTN","PSGOE9",70,0)
S:X="F" X="R"
"RTN","PSGOE9",71,0)
I ",?,??,C,O,OC,P,R,"'[(","_X_",") W " ??" G A7
"RTN","PSGOE9",72,0)
I $$PRNOK^PSGS0($G(PSGSCH)),X="C" W " ??" G A7
"RTN","PSGOE9",73,0)
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,7) G A7
"RTN","PSGOE9",74,0)
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A7
"RTN","PSGOE9",75,0)
;*223 Don't allow O sched type on C orders
"RTN","PSGOE9",76,0)
I X="O",$$SCHTP^PSGOE8(PSGSCH)'="O" W !," SCHEDULE ("_PSGSCH_") is not a ONE TIME Schedule." G A7
"RTN","PSGOE9",77,0)
;*269 Don't allow C sched type on O orders
"RTN","PSGOE9",78,0)
I X="C",$$SCHTP^PSGOE8(PSGSCH)="O" W !," SCHEDULE ("_PSGSCH_") is not a CONTINUOUS Schedule." G A7
"RTN","PSGOE9",79,0)
S PSGOST=PSGST
"RTN","PSGOE9",80,0)
S PSGST=X,PSGSTN=$$ENSTN^PSGMI(X) W:PSGSTN]"" " ",PSGSTN
"RTN","PSGOE9",81,0)
I X="P",$G(PSGAT)]"" S PSGOAT=PSGAT S PSGAT="" D
"RTN","PSGOE9",82,0)
.W !!,"NOTE: This change in schedule type also changes the ADMIN TIMES.",!
"RTN","PSGOE9",83,0)
.S MSG=1,PSGOEEF(39)=1
"RTN","PSGOE9",84,0)
.I $G(PSJNEWOE) D PAUSE^VALM1
"RTN","PSGOE9",85,0)
G DONE
"RTN","PSGOE9",86,0)
;
"RTN","PSGOE9",87,0)
26 ; schedule
"RTN","PSGOE9",88,0)
S MSG=0,PSGF2=26 S:PSGOEEF(PSGF2) BACK="26^PSGOE9"
"RTN","PSGOE9",89,0)
A26 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
"RTN","PSGOE9",90,0)
. W !!?5,"Schedule may not be edited for active complex orders." D PAUSE^VALM1
"RTN","PSGOE9",91,0)
W !,"SCHEDULE: ",$S(PSGSCH]"":PSGSCH_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
"RTN","PSGOE9",92,0)
S:X="" X=PSGSCH,PSGSCH="" I "@"[X W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,26) G A26
"RTN","PSGOE9",93,0)
S DOW=0 I $$DOW^PSIVUTL($$ENLU^PSGMI(X)) S DOW=1
"RTN","PSGOE9",94,0)
I X?1."?" D ENHLP^PSGOEM(55.06,26) G A26
"RTN","PSGOE9",95,0)
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A26
"RTN","PSGOE9",96,0)
;BHW;PSJ*5*188;Add flag and IEN return variable for PSGS0 (PSJ*5*134), Highlight Admin Times if they changed.
"RTN","PSGOE9",97,0)
N PSJSLUP,PSGSFLG S PSJSLUP=1,PSGSFLG=1 D EN^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,26) G A26
"RTN","PSGOE9",98,0)
I X'=PSGSCH D
"RTN","PSGOE9",99,0)
. N XX
"RTN","PSGOE9",100,0)
. K PSGDUR,PSGRMVT,PSGRMV,ND2P1 ;*315 Removal times are tied to ADMIN times.
"RTN","PSGOE9",101,0)
. S PSGSCH=X
"RTN","PSGOE9",102,0)
. I PSGS0Y'=PSGAT S PSGAT=PSGS0Y ;Change so that any schedule change will adjust the type and default the admin times - DRF
"RTN","PSGOE9",103,0)
. D ;Change schedule type to agree with schedule
"RTN","PSGOE9",104,0)
.. I $G(DOW) S PSGST="C",PSGSTN=$$ENSTN^PSGMI(PSGST) Q
"RTN","PSGOE9",105,0)
.. I (PSGSCH[" PRN")!(PSGSCH="PRN") I $$PRNOK^PSGS0(PSGSCH) S PSGOST=PSGST,PSGST="P",PSGSTN=$$ENSTN^PSGMI(PSGST) Q
"RTN","PSGOE9",106,0)
.. I '$G(PSGSCIEN),PSGSCH]"" S XX=+$O(^PS(51.1,"AC","PSJ",PSGSCH,0)),PSGSCIEN=XX ;PSGSCIEN should be set by call to EN^PSGS0
"RTN","PSGOE9",107,0)
.. S PSGST=$P($G(^PS(51.1,PSGSCIEN,0)),"^",5) I PSGST="D" S PSGST="C" ;DOW schedules are converted to Continuous
"RTN","PSGOE9",108,0)
.. S PSGSTN=$$ENSTN^PSGMI(PSGST)
"RTN","PSGOE9",109,0)
. W !!,"NOTE: This change in schedule also changes the ADMIN TIMES and SCHEDULE TYPE.",!
"RTN","PSGOE9",110,0)
. S MSG=1,PSGOEEF(39)=1
"RTN","PSGOE9",111,0)
. I ($G(PSGRF)>1),PSGST="C" D
"RTN","PSGOE9",112,0)
.. S PSGF2=41,BACK="41^PSGOE91",PSGOEEF(PSGF2)=1 D 41^PSGOE91 S BACK="26^PSGOE9",PSGF2=26,PSGOAT=PSGAT ;*315 Prompt for Admin to get DOA
"RTN","PSGOE9",113,0)
..Q
"RTN","PSGOE9",114,0)
. I $G(PSJNEWOE) D PAUSE^VALM1
"RTN","PSGOE9",115,0)
I PSGST="O" S PSGOEEF(7)=1 I +$G(PSGRF) S PSGOEEF(34)=1 D 34^PSGOE91 S PSGF2=26
"RTN","PSGOE9",116,0)
;
"RTN","PSGOE9",117,0)
DONE ;
"RTN","PSGOE9",118,0)
I PSGOEE G:'$G(PSGOEEF(PSGF2)) @BACK S PSGOEE=PSGOEEF(PSGF2)
"RTN","PSGOE9",119,0)
K F,F0,PSGF2 Q
"RTN","PSGOE9",120,0)
;
"RTN","PSGOE9",121,0)
DEL ; delete entry
"RTN","PSGOE9",122,0)
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
"RTN","PSGOE9",123,0)
Q
"RTN","PSIVEDT")
0^4^B52942616
"RTN","PSIVEDT",1,0)
PSIVEDT ;BIR/MLM - EDIT IV ORDER ;2/10/98 3:23 PM
"RTN","PSIVEDT",2,0)
;;5.0;INPATIENT MEDICATIONS;**4,110,127,133,134,181,252,281,366**;16 DEC 97;Build 3
"RTN","PSIVEDT",3,0)
;
"RTN","PSIVEDT",4,0)
; Reference to ^PS(53.1 is supported by DBIA 2256.
"RTN","PSIVEDT",5,0)
; Reference to ^PS(52.7 is supported by DBIA 2173.
"RTN","PSIVEDT",6,0)
; Reference to ^PS(51.2 is supported by DBIA 2178.
"RTN","PSIVEDT",7,0)
; Reference to ^PS(50.7 is supported by DBIA 2180.
"RTN","PSIVEDT",8,0)
; Reference to ^PS(55 is supported by DBIA 2191.
"RTN","PSIVEDT",9,0)
;
"RTN","PSIVEDT",10,0)
EDIT ;
"RTN","PSIVEDT",11,0)
;Store the DRG array. If it changed then to do an OC
"RTN","PSIVEDT",12,0)
NEW TMPDRG,PSJFLG57,PSIVE,PSIALLFL
"RTN","PSIVEDT",13,0)
D SAVEDRG^PSIVEDRG(.TMPDRG,.DRG)
"RTN","PSIVEDT",14,0)
I $G(DFN)&($G(PSJORD)["V") I $$COMPLEX^PSJOE(DFN,PSJORD) D
"RTN","PSIVEDT",15,0)
. N X,Y,PARENT,P2ND S P2ND=$S($G(^PS(55,PSGP,"IV",+PSJORD,.2)):$G(^PS(55,PSGP,"IV",+PSJORD,.2)),1:$G(^PS(55,PSGP,5,+PSJORD,.2)))
"RTN","PSIVEDT",16,0)
. S PARENT=$P(P2ND,"^",8)
"RTN","PSIVEDT",17,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,PSJORD)
"RTN","PSIVEDT",18,0)
S DONE=0
"RTN","PSIVEDT",19,0)
F PSIVE=1:1 S:DONE&$E(PSIVAC)="C" OREND=1 Q:PSIVE>$L(EDIT,U)!(DONE) Q:'$L($P(EDIT,U,PSIVE)) D @($P(EDIT,U,PSIVE)) S:$E(PSIVAC,2)="N" PSIVOK=PSIVOK_U_$P(EDIT,U,PSIVE) I $E(X)=U,$L(X)>1 S:PSIVE>1 PSIVE=PSIVE-1 F D FF Q:Y<0 D @Y Q:$E(X)'=U
"RTN","PSIVEDT",20,0)
I $G(PSGORQF) K PSIVEDIT S PSJOCCHK=1,PSIVENO=1 ;RTC 151046
"RTN","PSIVEDT",21,0)
I '$G(PSGORQF),$G(PSJOCCHK) K PSJOCCHK,PSIVENO D OC^PSIVOC
"RTN","PSIVEDT",22,0)
K EDIT,PSIVOK,PSGDI
"RTN","PSIVEDT",23,0)
;If quit then restore DRG( to pre-edit state
"RTN","PSIVEDT",24,0)
I $G(PSGORQF) D SAVEDRG^PSIVEDRG(.DRG,.TMPDRG)
"RTN","PSIVEDT",25,0)
Q
"RTN","PSIVEDT",26,0)
;
"RTN","PSIVEDT",27,0)
1 ; Provider.
"RTN","PSIVEDT",28,0)
I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+$G(ON),0)),"^",24)="R" D Q
"RTN","PSIVEDT",29,0)
. W !!?5,"This is Renewal order. Provider may not be edited at this point." D PAUSE^VALM1
"RTN","PSIVEDT",30,0)
I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q
"RTN","PSIVEDT",31,0)
.Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Provider may not be edited at this point." D PAUSE^VALM1
"RTN","PSIVEDT",32,0)
S P(6)=$S('$G(^VA(200,+P(6),"PS")):"",'$P(^("PS"),U,4):P(6),$P(^("PS"),U,4)<DT:"",1:P(6))
"RTN","PSIVEDT",33,0)
W !,"PROVIDER: "_$S($P(P(6),U,2)]"":$P(P(6),U,2)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(X=""&P(6)) Q
"RTN","PSIVEDT",34,0)
I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS^PSIVEDT1 G 1
"RTN","PSIVEDT",35,0)
I X]"" K DIC S DIC=200,DIC(0)="EQMZ",DIC("S")="I $D(^(""PS"")),^(""PS""),$S('$P(^(""PS""),U,4):1,$P(^(""PS""),U,4)>DT:1,1:0)" D ^DIC K DIC I Y>0 S P(6)=+Y_U_Y(0,0) Q
"RTN","PSIVEDT",36,0)
S F1=53.1,F2=1 D ENHLP^PSIVORC1 W $C(7),!!,"A Provider must be entered.",!! G 1
"RTN","PSIVEDT",37,0)
Q
"RTN","PSIVEDT",38,0)
;
"RTN","PSIVEDT",39,0)
3 ; Med Route.
"RTN","PSIVEDT",40,0)
I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q
"RTN","PSIVEDT",41,0)
. W !!?5,"Med Route may not be edited at this point." D PAUSE^VALM1
"RTN","PSIVEDT",42,0)
I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q
"RTN","PSIVEDT",43,0)
.Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Med Route may not be edited at this point." D PAUSE^VALM1
"RTN","PSIVEDT",44,0)
S P(6)=$S('$G(^VA(200,+P(6),"PS")):"",'$P(^("PS"),U,4):P(6),$P(^("PS"),U,4)<DT:"",1:P(6))
"RTN","PSIVEDT",45,0)
I P("MR")="" D
"RTN","PSIVEDT",46,0)
.N AD,SOL,OI,RT,RTCNT
"RTN","PSIVEDT",47,0)
.S AD=0 F S AD=$O(DRG("AD",AD)) Q:'AD S OI=$P(DRG("AD",AD),"^",6) I OI S OI(OI)=""
"RTN","PSIVEDT",48,0)
.S SOL=0 F S SOL=$O(DRG("SOL",SOL)) Q:'SOL S OI=$P(DRG("SOL",SOL),"^",6) I OI S OI(OI)=""
"RTN","PSIVEDT",49,0)
.S OI="" F S OI=$O(OI(OI)) Q:'OI S RT=$P(^PS(50.7,OI,0),"^",6) S:RT="" RT="NONE" S RT(RT)=$P($G(^PS(51.2,+RT,0)),"^",3)
"RTN","PSIVEDT",50,0)
.S RT="" F RTCNT=0:1 S RT=$O(RT(RT)) Q:RT=""
"RTN","PSIVEDT",51,0)
.Q:RTCNT>1
"RTN","PSIVEDT",52,0)
.S RT=$O(RT("")) I RT]"" S P("MR")=RT_"^"_$G(RT(RT))
"RTN","PSIVEDT",53,0)
W !,"MED ROUTE: "_$S($P(P("MR"),U,2)]"":$P(P("MR"),U,2)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I X=U!(X=""&P("MR"))!($E(X)=U) Q
"RTN","PSIVEDT",54,0)
I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS^PSIVEDT1 G 3
"RTN","PSIVEDT",55,0)
I X]"" K DIC S DIC=51.2,DIC(0)="EQMZX",DIC("S")="I $P(^(0),U,4)" D ^DIC K DIC I Y>0 S P("MR")=+Y_U_$P(Y(0),U,3) S:$E($G(PSJOCFG),1,2)="FN" PSJFNDS=1 Q ;366
"RTN","PSIVEDT",56,0)
S F1=53.1,F2=3 D ENHLP^PSIVORC1 W $C(7),!!,"A Med Route must be entered." G 3
"RTN","PSIVEDT",57,0)
Q
"RTN","PSIVEDT",58,0)
;
"RTN","PSIVEDT",59,0)
10 ; Start Date.
"RTN","PSIVEDT",60,0)
D 10^PSIVEDT1
"RTN","PSIVEDT",61,0)
I $E($G(PSJOCFG),1,2)="FN" S PSJFNDS=1
"RTN","PSIVEDT",62,0)
Q
"RTN","PSIVEDT",63,0)
;
"RTN","PSIVEDT",64,0)
25 ; Stop Date.
"RTN","PSIVEDT",65,0)
D 25^PSIVEDT1
"RTN","PSIVEDT",66,0)
I $E($G(PSJOCFG),1,2)="FN" S PSJFNDS=1
"RTN","PSIVEDT",67,0)
Q
"RTN","PSIVEDT",68,0)
26 ; Schedule
"RTN","PSIVEDT",69,0)
D 26^PSIVEDT1
"RTN","PSIVEDT",70,0)
Q
"RTN","PSIVEDT",71,0)
;
"RTN","PSIVEDT",72,0)
39 ; Admin Times.
"RTN","PSIVEDT",73,0)
D 39^PSIVEDT1
"RTN","PSIVEDT",74,0)
Q
"RTN","PSIVEDT",75,0)
;
"RTN","PSIVEDT",76,0)
57 ; Additive.
"RTN","PSIVEDT",77,0)
I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q
"RTN","PSIVEDT",78,0)
. W !!?5,"Additive may not be edited at this point." D PAUSE^VALM1
"RTN","PSIVEDT",79,0)
I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q
"RTN","PSIVEDT",80,0)
.Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Provider may not be edited at this point." D PAUSE^VALM1
"RTN","PSIVEDT",81,0)
I $E(PSIVAC)="O" W !!,"Only additives marked for use in IV Fluid Order Entry may be selected."
"RTN","PSIVEDT",82,0)
; Reference to ^PS(52.6 is supported by DBIA 1231.
"RTN","PSIVEDT",83,0)
S FIL=52.6,DRGT="AD",DRGTN="ADDITIVE" D DRG^PSIVEDRG,DKILL
"RTN","PSIVEDT",84,0)
;I $G(X)="^" G DKILL
"RTN","PSIVEDT",85,0)
;If Solution prompt is next then wait to do dose checks after all solutions are entered.
"RTN","PSIVEDT",86,0)
;PSJFLG57 is set so OC is triggered when the user entered ^ADDITIVE.
"RTN","PSIVEDT",87,0)
I $$COMPARE^PSJMISC(.DRG,.TMPDRG) D
"RTN","PSIVEDT",88,0)
. D ENSTOP^PSIVCAL
"RTN","PSIVEDT",89,0)
. I $S($G(PSJFLG57):1,($G(EDIT)'["58"):1,1:0) K PSJFLG57,PSJOCCHK D OC^PSIVOC S:$G(EDIT)]"" PSJENHOC=1
"RTN","PSIVEDT",90,0)
I $G(X)="^" G DKILL
"RTN","PSIVEDT",91,0)
Q
"RTN","PSIVEDT",92,0)
;
"RTN","PSIVEDT",93,0)
58 ; Solution.
"RTN","PSIVEDT",94,0)
NEW PSJCMPFG
"RTN","PSIVEDT",95,0)
I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q
"RTN","PSIVEDT",96,0)
. W !!?5,"Solution may not be edited at this point." D PAUSE^VALM1
"RTN","PSIVEDT",97,0)
S FIL=52.7,DRGT="SOL",DRGTN="SOLUTION" D DRG^PSIVEDRG
"RTN","PSIVEDT",98,0)
;I $G(X)="^" G DKILL
"RTN","PSIVEDT",99,0)
;I $G(X)']"^",$$COMPARE^PSJMISC(.DRG,.TMPDRG) D OC^PSIVOC
"RTN","PSIVEDT",100,0)
S PSJCMPFG=$$COMPARE^PSJMISC(.DRG,.TMPDRG)
"RTN","PSIVEDT",101,0)
I 'PSJCMPFG,$$COMPARE^PSJMISC(.DRG,.TMPDRG,1) D
"RTN","PSIVEDT",102,0)
. NEW X,PSJALLGY
"RTN","PSIVEDT",103,0)
. K PSJALLGY
"RTN","PSIVEDT",104,0)
. D SETDD^PSIVOC(1)
"RTN","PSIVEDT",105,0)
. D GMRAOC^PSJOC S:'$G(PSGORQF) PSIALLFL=1
"RTN","PSIVEDT",106,0)
. K PSJALLGY
"RTN","PSIVEDT",107,0)
Q:$G(PSGORQF)
"RTN","PSIVEDT",108,0)
I PSJCMPFG K PSJOCCHK D ENSTOP^PSIVCAL D OC^PSIVOC S:$G(EDIT)]"" PSJENHOC=1
"RTN","PSIVEDT",109,0)
K PSJCMPFG
"RTN","PSIVEDT",110,0)
I $G(X)="^" G DKILL
"RTN","PSIVEDT",111,0)
;
"RTN","PSIVEDT",112,0)
DKILL ; Kill for drug edit.
"RTN","PSIVEDT",113,0)
K DRGI,DRGN,DRGT,DRGTN,FIL,PSIVSTR
"RTN","PSIVEDT",114,0)
Q
"RTN","PSIVEDT",115,0)
;
"RTN","PSIVEDT",116,0)
59 ; Infusion Rate.
"RTN","PSIVEDT",117,0)
D 59^PSIVEDT1
"RTN","PSIVEDT",118,0)
Q
"RTN","PSIVEDT",119,0)
;
"RTN","PSIVEDT",120,0)
62 ; IV Room.
"RTN","PSIVEDT",121,0)
N DIR S DIR(0)="PA^59.5",DIR("A")="IV Room: ",DIR("??")="^S F1=59.5,F2=.01 D ENHLP^PSIVORC1" S:P("IVRM") DIR("B")=$P(P("IVRM"),U,2)
"RTN","PSIVEDT",122,0)
D ^DIR Q:$D(DIRUT) I Y>0 S P("IVRM")=Y W $P($P(Y,U,2),X,2)
"RTN","PSIVEDT",123,0)
Q
"RTN","PSIVEDT",124,0)
;
"RTN","PSIVEDT",125,0)
63 ; Remarks.
"RTN","PSIVEDT",126,0)
D 63^PSIVEDT1
"RTN","PSIVEDT",127,0)
Q
"RTN","PSIVEDT",128,0)
;
"RTN","PSIVEDT",129,0)
64 ; Other Print Info.
"RTN","PSIVEDT",130,0)
D 64^PSIVEDT1
"RTN","PSIVEDT",131,0)
Q
"RTN","PSIVEDT",132,0)
;
"RTN","PSIVEDT",133,0)
66 ; Provider's comments.
"RTN","PSIVEDT",134,0)
N DA,DIE,DIR,DR S DA=PSIVUP,DIE="^PS(53.45,",DR=4 D ^DIE S PSGSI=X,Y=1
"RTN","PSIVEDT",135,0)
Q
"RTN","PSIVEDT",136,0)
;
"RTN","PSIVEDT",137,0)
101 ; Orderable Item.
"RTN","PSIVEDT",138,0)
I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q
"RTN","PSIVEDT",139,0)
. W !!?5,"This is Renewal order. Orderable Item may not be edited at this point." D PAUSE^VALM1
"RTN","PSIVEDT",140,0)
I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q
"RTN","PSIVEDT",141,0)
.Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Orderable Item may not be edited at this point." D PAUSE^VALM1
"RTN","PSIVEDT",142,0)
W !,"Orderable Item: "_$S(P("PD"):$P(P("PD"),U,2)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(X=""&P("PD")) Q
"RTN","PSIVEDT",143,0)
I X]"" N DIC S DIC="^PS(50.7,",DIC(0)="EMQZ",DIC("B")=$S(P("PD")]"":+$P(("PD"),U),1:""),DIC("S")="S PSJSCT=1 I $$DRGSC^PSIVUTL(Y,PSJSCT) K PSJSCT" D ^DIC K DIC I Y>0 S P("PD")=Y Q
"RTN","PSIVEDT",144,0)
W $C(7),!!,"Orderable Item is required!",!! G 101
"RTN","PSIVEDT",145,0)
Q
"RTN","PSIVEDT",146,0)
109 ; Dosage Ordered.
"RTN","PSIVEDT",147,0)
W !,"DOSAGE ORDERED: "_$S(P("DO")]"":P("DO")_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(P("DO")]""&(X="")) Q
"RTN","PSIVEDT",148,0)
I X="???" D ORFLDS^PSIVEDT1 G 109
"RTN","PSIVEDT",149,0)
D:X]"" CHK^DIE(53.1,109,"",X,.X) I $G(X)="^" W $C(7),!!,"Enter the dosage in which the Orderable Item entered should be dispensed.",! W "Answer must be 1-20 characters in length." G 109
"RTN","PSIVEDT",150,0)
S P("DO")=X
"RTN","PSIVEDT",151,0)
Q
"RTN","PSIVEDT",152,0)
;
"RTN","PSIVEDT",153,0)
FF ; up-arrow to another field.
"RTN","PSIVEDT",154,0)
N DIC S X=$P(X,U,2),DIC="^DD(53.1,",DIC(0)="QEM",DIC("S")="I U_PSIVOK_U[(U_+Y_U)" D ^DIC K DIC S Y=+Y
"RTN","PSIVEDT",155,0)
I Y=57 S PSJFLG57=1
"RTN","PSIVEDT",156,0)
Q
"RTN","PSIVEDT",157,0)
;
"RTN","PSIVEDT",158,0)
NEWDRG ; Ask if adding a new drug.
"RTN","PSIVEDT",159,0)
K DIR S DIR(0)="Y",DIR("A")="Are you adding "_$P(TDRG,U,2)_" as a new "_$S(DRGT="AD":"additive",1:"solution")_" for this order",DIR("B")="NO" D ^DIR I $D(DTOUT)!$D(DUOUT) Q
"RTN","PSIVEDT",160,0)
I Y S (DRGI,DRG(DRGT,0))=DRG(DRGT,0)+1,DRG=TDRG,DRG(DRGT,+DRGI)=+DRG_U_$P(DRG,U,2) I DRGT="SOL" S X=$G(^PS(52.7,+DRG,0)),$P(DRG(DRGT,DRG),U,3)=$P(X,U,3)
"RTN","PSIVEDT",161,0)
Q
"VER")
8.0^22.2
**END**
**END**