1 | PSGOE8 ;BIR/CML3-EDIT ORDERS IN 53.1 ;25 SEP 97 / 10:58 AM
|
---|
2 | ;;5.0; INPATIENT MEDICATIONS ;**47,50,65,72,110,111,188,192**;16 DEC 97;Build 1
|
---|
3 | ;
|
---|
4 | ; Reference to ^PS(50.7 is supported by DBIA# 2180
|
---|
5 | ; Reference to ^PS(51.1 is supported by DBIA 2177
|
---|
6 | ; Reference to ^PS(51.2 is supported by DBIA# 2178
|
---|
7 | ; Reference to ^PSDRUG is supported by DBIA# 2192
|
---|
8 | ;
|
---|
9 | 101 ;Orderable Item
|
---|
10 | S MSG=0,F2=101,PSGOOPD=PSGPD,PSGOOPDN=PSGPDN S:PSGOEEF(F2) BACK="101^PSGOE8"
|
---|
11 | 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:%
|
---|
12 | I %'=1 G DONE
|
---|
13 | A101 ;
|
---|
14 | I $$PNDREN($G(PSGORD)) D Q
|
---|
15 | . W !!?5,"Orderable Item may not be edited at this point." D PAUSE^VALM1
|
---|
16 | W !,"ORDERABLE ITEM: ",$S(PSGPD:PSGPDN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
|
---|
17 | I X="",PSGPD S X=PSGPDN I PSGPD'=PSGPDN,$D(^PS(50.7,PSGPD,0)) G DONE
|
---|
18 | I $S(X="@":1,X]"":0,1:'PSGPD) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,101) G A101
|
---|
19 | I X?1."?" D ENHLP^PSGOEM(53.1,101)
|
---|
20 | I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A101
|
---|
21 | ;BHW;PSJ*5.0*192;Modify ^DIC call to use MIX^DIC and only B/C cross-references
|
---|
22 | 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
|
---|
23 | F S %=2 D DH,YN^DICN Q:%
|
---|
24 | I %'=1 G A101
|
---|
25 | S (PSGPDRG,PSGPD)=+Y,(PSGPDN,PSGPDRGN)=$$OINAME^PSJLMUTL(PSGPDRG)
|
---|
26 | S PSGNEDFD=$$GTNEDFD^PSGOE7("U",PSGPDRG)
|
---|
27 | 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
|
---|
28 | .S ^PS(53.45,PSJSYSP,2,0)="^53.4502P^1^1",^(1,0)=X,^PS(53.45,PSJSYSP,2,"B",X,1)=""
|
---|
29 | D ENDRG^PSGOEF1(PSGPD,0)
|
---|
30 | G DONE
|
---|
31 | ;
|
---|
32 | 109 ; dosage ordered
|
---|
33 | S MSG=0,F2=109 S:PSGOEEF(F2) BACK="109^PSGOE8"
|
---|
34 | A109 ;
|
---|
35 | I $$PNDREN($G(PSGORD)) D Q
|
---|
36 | . W !!?5,"Dosage may not be edited at this point." D PAUSE^VALM1
|
---|
37 | S PSGOEEF(F2)=PSGOEE
|
---|
38 | D EDITDOSE^PSJDOSE S X=PSGDO G DONE
|
---|
39 | W !,"DOSAGE ORDERED: ",$S(PSGDO]"":PSGDO_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
|
---|
40 | I X=""&(PSGDO]"") S X=PSGDO
|
---|
41 | I $$CHECK(PSJSYSP)&(X="")&(PSGDO']"") W $C(7)," (Required) " G A109
|
---|
42 | I $$CHECK(PSJSYSP)&(X="@") W $C(7)," (Required) " G A109
|
---|
43 | I '$$CHECK(PSJSYSP)&(X="@") S PSGDO="" G DONE
|
---|
44 | I X?1."?" D ENHLP^PSGOEM(53.1,109) G A109
|
---|
45 | I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A109
|
---|
46 | I $E(X,$L(X))=" " F S X=$E(X,1,$L(X)-1) Q:$E(X,$L(X))'=" "
|
---|
47 | 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
|
---|
48 | S PSGDO=X G DONE
|
---|
49 | ;
|
---|
50 | 3 ; med route
|
---|
51 | S MSG=0,F2=3 S:PSGOEEF(F2) BACK="3^PSGOE8"
|
---|
52 | A3 I $$PNDREN($G(PSGORD)) D Q
|
---|
53 | . W !!?5,"Med Route may not be edited at this point." D PAUSE^VALM1
|
---|
54 | W !,"MED ROUTE: ",$S(PSGMR:PSGMRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
|
---|
55 | I X="",PSGMR S X=PSGMRN I PSGMR'=PSGMRN,$D(^PS(51.2,PSGMR,0)) W " "_$P(^(0),"^",3) G DONE
|
---|
56 | I $S(X="@":1,X]"":0,1:'PSGMR) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,3) G A3
|
---|
57 | I X?1."?" D ENHLP^PSGOEM(53.1,3)
|
---|
58 | I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A3
|
---|
59 | K DIC S DIC="^PS(51.2,",DIC(0)="EMQZ",DIC("S")="I $P(^(0),""^"",4)" D ^DIC K DIC I Y'>0 G A3
|
---|
60 | S PSGMR=+Y,PSGMRN=Y(0,0) G DONE
|
---|
61 | ;
|
---|
62 | 7 ; schedule type
|
---|
63 | S MSG=0,F2=7 S:PSGOEEF(F2) BACK="7^PSGOE8"
|
---|
64 | 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
|
---|
65 | I X="" W:PSGSTN]"" " ",PSGSTN G DONE
|
---|
66 | I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,7) G A7
|
---|
67 | I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A7
|
---|
68 | ; I X="OC"!(X="R") S PSGST=X,$P(PSGNEDFD,"^",3)=X,PSGSTN=$S(X="R":"FILL on REQUEST",1:"ON CALL") W " "_PSGSTN S PSGOEEF(7)="" G:X="R" 26 S PSGSCH=PSGSTN,(PSGS0Y,PSGS0XT)="" G 8^PSGOE41
|
---|
69 | A7DEF ;BHW;PSJ*5*188;Added tag. Called by A26 to set default Schedule type.
|
---|
70 | F Y="C^CONTINUOUS","O^ONE TIME","OC^ON CALL","P^PRN","R^FILL on REQUEST" I $S(X=$P(Y,"^"):1,1:$P($P(Y,"^",2),X)="") W $S(X=$P(Y,"^"):" "_$P(Y,"^",2),1:$P($P(Y,"^",2),X,2)) S PSGST=$P(Y,"^"),PSGSTN=$P(Y,"^",2),$P(PSGNEDFD,"^",3)=PSGST Q
|
---|
71 | E W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,7) G A7
|
---|
72 | ; I PSGST="OC"!(PSGST="R") S PSGOEEF(7)="" G:PSGST="R" 26 S PSGSCH=PSGSTN,(PSGS0Y,PSGS0XT)="" G 8^PSGOE41
|
---|
73 | G DONE
|
---|
74 | ;
|
---|
75 | 26 ; schedule
|
---|
76 | S MSG=0,F2=26 S:PSGOEEF(F2) BACK="26^PSGOE8"
|
---|
77 | A26 I $$PNDREN($G(PSGORD)) D Q
|
---|
78 | . W !!?5,"Schedule may not be edited at this point." D PAUSE^VALM1
|
---|
79 | W !,"SCHEDULE: ",$S(PSGSCH]"":PSGSCH_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
|
---|
80 | S:X="" X=PSGSCH,PSGSCH="" I "@"[X W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,26) G A26
|
---|
81 | I X?1."?" D ENHLP^PSGOEM(53.1,26) G A26
|
---|
82 | I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A26
|
---|
83 | ;BHW;PSJ*5*188;Add flag and IEN return variable for PSGS0 (PSJ*5*134), Highlight Admin Times if they changed.
|
---|
84 | N PSGOES,PSJSLUP,PSGSFLG,PSGSCIEN S PSJSLUP=1,PSGSFLG=1 D EN^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,26) G A26
|
---|
85 | S PSGSCH=X I PSGS0Y'=PSGAT S PSGAT=PSGS0Y W !!,"NOTE: This change in schedule also changes the ADMIN TIMES.",! S MSG=1,PSGOEEF(39)=1 D:$G(PSJNEWOE) PAUSE^VALM1
|
---|
86 | ;BHW;PSJ*5*188;Get Schedule type of Selected Schedule, If One-Time type, set Highlighting ON (PSGOEEF(7)=1) and call existing Schedule type logic.
|
---|
87 | N X,Y,DIC
|
---|
88 | I '$G(PSGSCIEN) S PSGSCIEN=$O(^PS(51.1,"AC","PSJ",PSGSCH,"")) ;Get First schedule with PSJ Package Prefix as default for Lookup
|
---|
89 | S X=$S($G(PSGSCIEN):$G(PSGSCIEN),1:PSGSCH),DIC="51.1",DIC(0)="NZ" D ^DIC
|
---|
90 | I $P($G(Y(0)),"^",5)="O" S X="O" S PSGOEEF(7)=1 G A7DEF
|
---|
91 | ;
|
---|
92 | DONE ;
|
---|
93 | I PSGOEE G:'PSGOEEF(F2) @BACK S PSGOEE=PSGOEEF(F2)
|
---|
94 | K F,F0,F2 Q
|
---|
95 | ;
|
---|
96 | DEL ; delete entry
|
---|
97 | W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
|
---|
98 | Q
|
---|
99 | ;
|
---|
100 | DH ;
|
---|
101 | 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."
|
---|
102 | 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 '^' the exit this edit." Q
|
---|
103 | ;
|
---|
104 | CHECK(PSJSYSP) ; Check to see if multiple dispense drugs
|
---|
105 | ; Input - PSJSYSP
|
---|
106 | ; Returns 0 = only one.
|
---|
107 | ; 1 = more than one
|
---|
108 | ; Checks Inactive Date and doesn't count if < or = today.
|
---|
109 | N PSJRSB,PSJINACT,PSJRBCNT S PSJRBCNT=0
|
---|
110 | F PSJRSB=0:0 S PSJRSB=$O(^PS(53.45,PSJSYSP,2,PSJRSB)) Q:'PSJRSB D
|
---|
111 | .S PSJINACT=$P(^PS(53.45,PSJSYSP,2,PSJRSB,0),"^",3)
|
---|
112 | .I (PSJINACT="")!((PSJINACT>0)&(PSJINACT>DT)) D
|
---|
113 | ..S PSJRBCNT=$S('$D(PSJRBCNT):1,1:PSJRBCNT+1)
|
---|
114 | Q $S(PSJRBCNT>1:1,1:0)
|
---|
115 | ;
|
---|
116 | PNDREN(PNDON) ;
|
---|
117 | I PNDON'["P" Q 0
|
---|
118 | S RNWL="^PS(53.1,"_+PNDON_",0)" S RNWL=$G(@(RNWL)) S RNWL=$S($P(RNWL,"^",24)="R":1,1:0)
|
---|
119 | Q RNWL
|
---|