source: FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGON.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1PSGON ;BIR/CML3-SELECT ORDERS ; 16 Dec 98 / 10:08 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**2,22,54**;16 DEC 97
3ENCHK ;
4 K PSGODDD S PSGODDD=1,PSGODDD(1)="" W:X="-" " (ALL)" I X="ALL"!(X="-") S X="1-"_PSGLMT
5 E S:$E(X)="-" X=1_X S:$E(X,$L(X))="-" X=X_PSGLMT
6 F Q=1:1:$L(X,",") S X1=$P(X,",",Q) D SET Q:'$D(X)
7 Q
8 ;
9SET ;
10 I $S(X1>PSGLMT:1,X1<1:1,X1?.N:0,1:X1'?1.N1"-"1.N) K X Q
11 I X1'["-" S X2=X1 G SET1
12 F X2=$P(X1,"-"):1:$P(X1,"-",2) D SET1 Q:'$D(X)
13 Q
14 ;
15SET1 ;
16 S X2=+X2 I $S(X2<1:1,X2>PSGLMT:1,$D(PSGEFN):'$D(PSGEFN(X2)),1:0) K X Q
17 I PSGODDD(PSGODDD) F QQ=+$G(PSGOESF):1:PSGODDD I ","_$G(PSGODDD(QQ))[(","_X2_",") Q
18 I Q
19 I $L(PSGODDD(PSGODDD))+$L(X2)>244 S PSGODDD=PSGODDD+1,PSGODDD(PSGODDD)=""
20 S PSGODDD(PSGODDD)=PSGODDD(PSGODDD)_X2_"," ;Q
21 Q
22 ;
23ENASR ; action/select read
24 ;S ACTION=$S($D(PSGPRF):0,PSGONC:1,PSGONV:1,$G(PSGONF):1,1:PSGONR>0)
25 S ACTION=0
26RD1 ;W !!,$S($D(PSGPRF):"View",1:"Select"),$S(ACTION:" ACTION or",1:"")," ORDER",$S(PSGLMT>1:"S (1-"_PSGLMT,1:" (1"),"): " R X:DTIME W:'$T $C(7) S:'$T X="^" I "^"[X K ACTION Q
27 W !!,$S($D(PSGPRF):"View",1:"Select"),$S(ACTION:" ACTION or",1:"")," ORDER",$S(PSGLMT>1:"S (1-"_PSGLMT,1:" (1"),"): " R X:DTIME W:'$T $C(7) S:'$T X="^" I X["^" K ACTION S X="^" Q
28 I X="" K ACTION Q
29 I X="DC",ACTION,PSGONC W " (DISCONTINUE)" S X="D" Q
30 I X="DC" W $C(7)," ??" G RD1
31 I $P("DISCONTINUE",X)="",ACTION,PSGONC W $P("DISCONTINUE",X,2) S X="D" Q
32 I $P("DISCONTINUE",X)="" W $C(7)," ??" G RD1
33 I $P("RENEW",X)="",ACTION,PSGONR W $P("RENEW",X,2) S X="R" Q
34 I $P("RENEW",X)="" W $C(7)," ??" G RD1
35 I $P("VERIFY",X)="",ACTION,PSGONV W $P("VERIFY",X,2) S X="V" Q
36 I $P("VERIFY",X)="" W $C(7)," ??" G RD1
37 I $P("FINISH",X)="",ACTION,$G(PSGONF) W $P("FINISH",X,2) S X="F" Q
38 I $P("FINISH",X)="" W $C(7)," ??" G RD1
39 I $S(X="ALL":1,X["-":1,1:X) D ENCHK Q:$D(X) W $C(7)," ??" G RD1
40 I X?1."?" D H1 G RD1
41 W $C(7)," ??" G RD1
42 ;
43H1 ;
44 D FULL^VALM1 W !!?2 I ACTION D
45 .W "Select ACTION to take on order",$E("s",PSGONR>1!(PSGONC>1)!(PSGONV>1)!($G(PSGONF)>1)),!,". Select -",! W:PSGONC ?9,"D for DISCONTINUE",! W:PSGONR ?9,"R for RENEW",! W:PSGONV ?9,"V for VERIFY",! W:$G(PSGONF) ?9,"F for FINISH",!
46 W !,"Select ORDER",$S(PSGLMT>1:"S (1-"_PSGLMT,1:" (1"),") to view",$S('$D(PSGPRF):" and/or on which to take action",1:""),"." D:X?2."?" H2
47 N DIR S DIR(0)="E" D ^DIR I $D(VALM("LINES")) D RE^VALM4
48 Q
49 ;
50ENWO ; which orders
51 S PSGLMT=$S(PSGONW="R":PSGONR,PSGONW="V":PSGONV,1:PSGONC)
52RDW ;
53 W !!,$S(PSGONW="V":"VERIFY which orders",PSGONW="R":$S($P(PSJSYSP0,"^",3):"RENEW which orders",1:"MARK which orders for RENEWAL"),1:$S($P(PSJSYSP0,"^",5):"DISCONTINUE which orders",1:"MARK which orders for DISCONTINUATION"))," (1-",PSGLMT,"): "
54 R X:DTIME W:'$T $C(7) S:'$T X="^" I "^"[X Q
55 I X?1."?" W !!?2,"Select order",$E("s",PSGLMT>1)," to ",$S(PSGONW="V":"verify",PSGONW="R":$S($P(PSJSYSP0,"^",3):"renew.",1:"mark for renewal."),1:$S($P(PSJSYSP0,"^",5):"discontinue.",1:"mark for discontinuation.")) D:X?2."?" H2 G RDW
56 D ENCHK I '$D(X) W $C(7)," ??" G RDW
57 Q
58 ;
59H2 ;
60 N X S X=$S($D(PSGEFN):"field",1:"order") W !!?2,"Select ",X,"s either singularly separated by commas (1,2,3), by a range of",!,X,"s separated by a dash (1-3), or a combination (1,2,4-6). To select all"
61 W !,X,"s, enter 'ALL' or a dash ('-'). You can also enter '-n' to select the"
62 W !,"first ",X," through the 'nth' ",X," or enter 'n-' to select the 'nth' ",X,!,"through the last ",X,". If an ",X," is selected more than once, only the first",!,"selection is used (Entering '1,2,1' would return '1,2'.)."
63 W:$D(PSGEFN) !!,?2,"Fields numbers are as follows:"
64 I '$D(P("PON")) D
65 .Q:'$D(PSGEFN)
66 .N PS S PS=$S($G(PSJORD)["P":1,$G(PSJORD)["U":2,1:2)
67 .W !?3,"*(1) Orderable Item",!,?3,$S(PS=1:" ",PS=2:"*"),"(2) Dosage Ordered"
68 .W !?3,$S(PS=1:" ",PS=2:"*"),"(3) Start",!?3,"*(4) Med Route",!?3,$S(PS=1:" ",PS=2:"*"),"(5) Stop"
69 .W !?3," (6) Schedule Type",!?3," (7) Self Med",!?3,"*(8) Schedule"
70 .W !?3," (9) Admin Times",!?3,"*(10) Provider",!?3," (11) Special "
71 .W "Instructions",!?3," (12) Dispense Drug"
72 E D
73 .Q:'$D(PSGEFN)
74 .N PS S PS=$S($G(PSJORD)["P":1,$G(PSJORD)["V":2,1:2)
75 .W !?3,$S($G(P("OT"))="F":"*",PS=1:" ",PS=2:"*"),"(1) Additives",!?3,$S($G(P("OT"))="F":"*",P(4)="P":" ",PS=1:" ",PS=2:"*"),"(2) Solutions",!?3,$S(P(4)="P":" ",PS=1:" ",PS=2:"*"),"(3) Infusion Rate"
76 .W !?3,$S(PS=1:" ",PS=2:"*"),"(4) Start",!?3,"*(5) Med Route",!?3,$S(PS=1:" ",PS=2:"*"),"(6) Stop"
77 .W !?3,"*(7) Schedule",!?3," (8) Admin Times",!?3,"*(9) Provider"
78 .I $G(P(4))="P"!($G(P("DTYP"))=0) D
79 ..W !?3,"*(10) Orderable Item",!?3," (11) Other Print",!?3," (12) Remarks"
80 .E W !?3," (10) Other Print",!?3," (11) Remarks"
81 W ! K DIR S DIR(0)="E" D ^DIR K DIR
82 Q
83 ;
84ENEFA ;
85 N Q,X1,X2 I '$D(PSGEFN) K Y S Y="" Q
86 ;
87EFA ;
88 K Y S Y="" R !!,"Select FIELDS TO EDIT: ",X:DTIME E W $C(7) S X="^" Q
89 I "^"[X Q
90 ;I X?1."?" D:$D(P("PON")) H2,@("DISPLAY^PSJLIFN") D:'$D(P("PON")) FULL^VALM1,EFH G EFA
91 I X="??"&('$D(P("PON"))) D FULL^VALM1,H2 G EFA
92 I X?1."?" D FULL^VALM1 D:'$D(P("PON")) EFH D:$D(P("PON")) H2,@("DISPLAY^PSJLIFN") G EFA
93 ;* I X?1."?" D EFH D:X?2."?" H2,READ^PSJUTL,@($S('$D(PSJDTYP):"ENW^PSGOEEW",PSJDTYP="OU":"ENW^PSJOEEW",PSJDTYP="O":"^PSIVORV1",1:"EN^PSIVORV2")) G EFA
94 I X="-"!($P("ALL",X)="") W $S(X="-":" (ALL)",1:$P("ALL",X,2)) F Q=0:0 S Q=$O(PSGEFN(Q)) Q:'Q S Y=Y_Q_","
95 I G FDONE
96 S:$E(X)="-" X=+PSGEFN_X S:$E($L(X))="-" X=X_$P(PSGEFN,":",2)
97 F Q=1:1:$L(X,",") S X1=$P(X,",",Q) D FS Q:'$D(X)
98 I '$D(X) W $C(7)," ??" G EFA
99 ;
100FDONE ;
101 I '$D(Y) W $C(7)," ??" G EFA
102 S:Y Y=$E(Y,1,$L(Y)-1) Q
103 ;
104FS ;
105 I $S(X1?1.N1"-"1.N:0,X1'?1.N:1,'$D(PSGEFN(X1)):1,1:","_Y[X1) K X Q
106 I X1'["-" S Y=Y_X1_"," Q
107 S X2=+X1,Y=Y_X2_"," F S X2=$O(PSGEFN(X2)) K:$S(X="":1,","_Y[X2:1,1:X2>$P(X1,"-",2)) Y Q:'$D(Y) S Y=Y_X2_"," Q:X2=$P(X1,"-",2)
108 Q
109ENEFA2 ;
110 I '$D(PSGEFN) K Y S Y="" Q
111 S Y=$P(XQORNOD(0),"=",2)
112 ; wasn't handling "0#" correctly, will strip off a leading zero on 1-9
113 N Q,X1 F Q=1:1:$L(Y,",") S X1=$P(Y,",",Q) D
114 .I X1?1"0"1.2N S $P(Y,",",Q)=+X1
115 Q
116 ;
117EFH ;
118 W !!?2,"Select the fields you wish to edit, by number. Only those fields with a",!,"number to the left of the field name are editable."
119 Q
Note: See TracBrowser for help on using the repository browser.