source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOE9.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1PSGOE9 ;BIR/CML3-EDIT ORDERS IN 55 ;13 May 98 / 7:58 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**11,47,50,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 ^PS(55 is supported by DBIA #2191
8 ; Reference to ^PSDRUG is supported by DBIA# 2192
9 ;
10101 ; Orderable Item (AKA primary drug)
11 S MSG=0,PSGF2=101,PSGOOPD=PSGPD,PSGOOPDN=PSGPDN S:PSGOEEF(PSGF2) BACK="101^PSGOE9"
12 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
13 I %'=1 G DONE
14A101 ;
15 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
16 . W !!?5,"Orderable Item may not be edited for active complex orders." D PAUSE^VALM1
17 W !,"ORDERABLE ITEM: ",$S(PSGPD:PSGPDN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
18 I X="",PSGPD S X=PSGPDN I PSGPD'=PSGPDN,$D(^PS(50.7,PSGPD,0)) G DONE
19 I $S(X="@":1,X]"":0,1:'PSGPD) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,101) G A101
20 I X?1."?" D ENHLP^PSGOEM(55.06,101)
21 I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A101
22 ;BHW;PSJ*5.0*192;Modify ^DIC call to use MIX^DIC and only B/C cross-references
23 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
24 F S %=2 D DH^PSGOE8,YN^DICN Q:%
25 I %'=1 G A101
26 S (PSGPDRG,PSGPD)=+Y,(PSGPDN,PSGPDRGN)=$$OINAME^PSJLMUTL(PSGPDRG)
27 S PSGNEDFD=$$GTNEDFD^PSGOE7("U",PSGPDRG)
28 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
29 D ENDRG^PSGOEF1(PSGPD,0)
30 G DONE
31 ;
32109 ; dosage ordered
33 S MSG=0,PSGF2=109 S:PSGOEEF(PSGF2) BACK="109^PSGOE9"
34A109 ;
35 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
36 . W !!?5,"Dosage may not be edited for active complex orders." D PAUSE^VALM1
37 D EDITDOSE^PSJDOSE S X=PSGDO G DONE
38 W !,"DOSAGE ORDERED: ",$S(PSGDO]"":PSGDO_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
39 I X=""&(PSGDO]"") S X=PSGDO
40 I $$CHECK^PSGOE8(PSJSYSP)&(X="")&(PSGDO']"") W $C(7)," (Required) " G A109
41 I $$CHECK^PSGOE8(PSJSYSP)&(X="@") W $C(7)," (Required)" G A109
42 I '$$CHECK^PSGOE8(PSJSYSP)&(X="@") S PSGDO="" G DONE
43 I X?1."?" D ENHLP^PSGOEM(55.06,109) G A109
44 I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A109
45 I $E(X,$L(X))=" " F S X=$E(X,1,$L(X)-1) Q:$E(X,$L(X))'=" "
46 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
47 S PSGDO=X G DONE
48 ;
493 ; med route
50 S MSG=0,PSGF2=3 S:PSGOEEF(PSGF2) BACK="3^PSGOE9"
51A3 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
52 . W !!?5,"Med Route may not be edited for active complex orders." D PAUSE^VALM1
53 W !,"MED ROUTE: ",$S(PSGMR:PSGMRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
54 I X="",PSGMR S X=PSGMRN I PSGMR'=PSGMRN,$D(^PS(51.2,PSGMR,0)) W " "_$P(^(0),"^",3) G DONE
55 I $S(X="@":1,X]"":0,1:'PSGMR) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,3) G A3
56 I X?1."?" D ENHLP^PSGOEM(55.06,3)
57 I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A3
58 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
59 S PSGMR=+Y,PSGMRN=Y(0,0) G DONE
60 ;
617 ; schedule type
62 S MSG=0,PSGF2=7 S:PSGOEEF(PSGF2) BACK="7^PSGOE9"
63A7 I $G(PSGP),$G(PSGORD) I $$COMPLEX^PSJOE(PSGP,PSGORD) D
64 . 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)
65 . 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)
66 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
67 I X="" W:PSGSTN]"" " ",PSGSTN G DONE
68 I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,7) G A7
69 I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A7
70 ; 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
71A7DEF ;BHW;PSJ*5*188;Added tag. Called by A26 to set default Schedule type.
72 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
73 E W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,7) G A7
74 ; I PSGST="OC"!(PSGST="R") S PSGOEEF(7)="" G:PSGST="R" 26 S PSGSCH=PSGSTN,(PSGS0Y,PSGS0XT)="" G 8^PSGOE41
75 G DONE
76 ;
7726 ; schedule
78 S MSG=0,PSGF2=26 S:PSGOEEF(PSGF2) BACK="26^PSGOE9"
79A26 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
80 . W !!?5,"Schedule may not be edited for active complex orders." D PAUSE^VALM1
81 W !,"SCHEDULE: ",$S(PSGSCH]"":PSGSCH_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
82 S:X="" X=PSGSCH,PSGSCH="" I "@"[X W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,26) G A26
83 I X?1."?" D ENHLP^PSGOEM(55.06,26) G A26
84 I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A26
85 ;BHW;PSJ*5*188;Add flag and IEN return variable for PSGS0 (PSJ*5*134), Highlight Admin Times if they changed.
86 N PSJSLUP,PSGSFLG,PSGSCIEN S PSJSLUP=1,PSGSFLG=1 D EN^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,26) G A26
87 S PSGSCH=X I PSGS0Y'=PSGAT S PSGAT=PSGS0Y,MSG=1 W !!,"NOTE: This change in schedule also changes the ADMIN TIMES.",! S MSG=1,PSGOEEF(39)=1 D:$G(PSJNEWOE) PAUSE^VALM1
88 ;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.
89 N X,Y,DIC
90 I '$G(PSGSCIEN) S PSGSCIEN=$O(^PS(51.1,"AC","PSJ",PSGSCH,"")) ;Get First schedule with PSJ Package Prefix as default for Lookup
91 S X=$S($G(PSGSCIEN):$G(PSGSCIEN),1:PSGSCH),DIC="51.1",DIC(0)="NZ" D ^DIC
92 I $P($G(Y(0)),"^",5)="O" S X="O" S PSGOEEF(7)=1 G A7DEF
93 ;
94DONE ;
95 I PSGOEE G:'PSGOEEF(PSGF2) @BACK S PSGOEE=PSGOEEF(PSGF2)
96 K F,F0,PSGF2 Q
97 ;
98DEL ; delete entry
99 W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
100 Q
Note: See TracBrowser for help on using the repository browser.