| 1 | PSGON ;BIR/CML3-SELECT ORDERS ; 16 Dec 98 / 10:08 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**2,22,54**;16 DEC 97
|
|---|
| 3 | ENCHK ;
|
|---|
| 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 | ;
|
|---|
| 9 | SET ;
|
|---|
| 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 | ;
|
|---|
| 15 | SET1 ;
|
|---|
| 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 | ;
|
|---|
| 23 | ENASR ; action/select read
|
|---|
| 24 | ;S ACTION=$S($D(PSGPRF):0,PSGONC:1,PSGONV:1,$G(PSGONF):1,1:PSGONR>0)
|
|---|
| 25 | S ACTION=0
|
|---|
| 26 | RD1 ;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 | ;
|
|---|
| 43 | H1 ;
|
|---|
| 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 | ;
|
|---|
| 50 | ENWO ; which orders
|
|---|
| 51 | S PSGLMT=$S(PSGONW="R":PSGONR,PSGONW="V":PSGONV,1:PSGONC)
|
|---|
| 52 | RDW ;
|
|---|
| 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 | ;
|
|---|
| 59 | H2 ;
|
|---|
| 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 | ;
|
|---|
| 84 | ENEFA ;
|
|---|
| 85 | N Q,X1,X2 I '$D(PSGEFN) K Y S Y="" Q
|
|---|
| 86 | ;
|
|---|
| 87 | EFA ;
|
|---|
| 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 | ;
|
|---|
| 100 | FDONE ;
|
|---|
| 101 | I '$D(Y) W $C(7)," ??" G EFA
|
|---|
| 102 | S:Y Y=$E(Y,1,$L(Y)-1) Q
|
|---|
| 103 | ;
|
|---|
| 104 | FS ;
|
|---|
| 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
|
|---|
| 109 | ENEFA2 ;
|
|---|
| 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 | ;
|
|---|
| 117 | EFH ;
|
|---|
| 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
|
|---|
