source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOE8.m@ 1258

Last change on this file since 1258 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.6 KB
Line 
1PSGOE8 ;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 ;
9101 ;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
13A101 ;
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 ;
32109 ; dosage ordered
33 S MSG=0,F2=109 S:PSGOEEF(F2) BACK="109^PSGOE8"
34A109 ;
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 ;
503 ; med route
51 S MSG=0,F2=3 S:PSGOEEF(F2) BACK="3^PSGOE8"
52A3 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 ;
627 ; schedule type
63 S MSG=0,F2=7 S:PSGOEEF(F2) BACK="7^PSGOE8"
64A7 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
69A7DEF ;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 ;
7526 ; schedule
76 S MSG=0,F2=26 S:PSGOEEF(F2) BACK="26^PSGOE8"
77A26 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 ;
92DONE ;
93 I PSGOEE G:'PSGOEEF(F2) @BACK S PSGOEE=PSGOEEF(F2)
94 K F,F0,F2 Q
95 ;
96DEL ; 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 ;
100DH ;
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 ;
104CHECK(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 ;
116PNDREN(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
Note: See TracBrowser for help on using the repository browser.