41 lines
2.5 KiB
Mathematica
41 lines
2.5 KiB
Mathematica
PSGOE0 ;BIR/CML3-PROFILE AND ORDER ENTRY ;25 SEP 97 / 7:42 AM
|
|
;;5.0; INPATIENT MEDICATIONS ;**110**;16 DEC 97
|
|
;
|
|
; Reference to ^PS(55 is supported by DBIA #2191.
|
|
; Reference to ^PS(51.2 is supported by DBIA# 2178.
|
|
;
|
|
START ; print orders
|
|
W:X]"" $P("^PROFILE",X,2) D ENL^PSGOU G:PSGOL="^" DONE G:PSGOL="N" ASK K PSGPR S PSGOEAV=0,PSJNARC=1,PSJOPC="UD" D ^PSGO I 'PSGON G ASK
|
|
;
|
|
ENVO ; view/act on orders
|
|
S PSGLMT=PSGON D ENASR^PSGON G:"^"[X ASK G:X["^^" DONE
|
|
I X="D" D EN^PSGOECS G:'$D(X) ENVO S X="^PROFILE" G START
|
|
I X="R" D EN^PSGOERS G:'$D(X) ENVO S X="^PROFILE" G START
|
|
I X="V" D EN^PSGOEVS G:'$D(X) ENVO S X="^PROFILE" G START
|
|
I X="F" D EN^PSGOESF G:'$D(X) ENVO S X="^PROFILE" G START
|
|
I PSGODDD S PSGOEA=""
|
|
I F PSGOE=1:1:PSGODDD F PSGOE1=1:1:$L(PSGODDD(PSGOE),",")-1 S PSGOE2=$P(PSGODDD(PSGOE),",",PSGOE1) D EN1^PSGVW K CONT D Q:'$D(PSGODDD)!($G(PSGOEA)["^")
|
|
.Q:$G(PSGOEA)["^" I $D(PSGPRF) W !!,"Press RETURN to continue: " R CONT:DTIME W @IOF S:CONT["^" PSGOEA="^"
|
|
.D ^PSGOE1:'$D(PSGPRF) Q:$G(PSGOEA)["^" I $D(PSGPRF),PSGORD["N",'$D(CONT) K DIR S DIR(0)="E" W ! D ^DIR Q:X["^"!$D(DIRUT)
|
|
;
|
|
;
|
|
ASK ; new orders entered here
|
|
K ^TMP("PSJON",$J),DIR,DIROUT,DIRUT,DRGI,DTOUT,DUOUT,PRI,PSGLMT,PSGODDD,PSGOE1,PSGOE2,PSGOEA,PSGOEE,PSGON,PSGONC,PSGONF,PSGONR,PSGONV Q:$D(PSGPRF) K PSGCANFL,PSGOL Q:'PSJPCAF
|
|
F W !!,"New order(s) for ",$P(PSGP(0),"^"),"? Y// " R X:DTIME W:'$T $C(7) S:'$T X="^" S:X="" X="Y" G:$P("^PROFILE",X)=""&(X'="^") START Q:"^YyNn"[X D:X?1."?" AM W:X'?1."?" $C(7)," ??"
|
|
W:"Nn"[X " (NO)" G:"^Nn"[X DONE W " (YES)"
|
|
I '$P(PSJSYSU,";",2) S PR=$P($G(^PS(55,PSGP,5.1)),"^",2) I PR D
|
|
.S X=$G(^VA(200,PR,"PS")) I $S('X:1,'$P(X,"^",4):0,1:DT'>$P(X,"^",4)) D:'$D(^PS(55,PSGP,0)) ENSET0^PSGNE3(PSGP) S $P(^PS(55,PSGP,5.1),"^",2)="",PR=""
|
|
S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU,PSGOEDMR=$O(^PS(51.2,"B","ORAL",0)),PSGOEPR=$S($P(PSJSYSU,";",2):DUZ,1:PR) S:'PSGOEPR PSGOEPR=PSJPTSP
|
|
;
|
|
DRG ;
|
|
D ^PSGOE7 G:Y<0 DONE G:$P("^PROFILE",X)="" START I X?1"S."1.E D ^PSGOES G DRG
|
|
W ! D ^PSGOE3:$P(PSJSYSP0,"^",12),^PSGOE4:'$P(PSJSYSP0,"^",12) K PSGOEE,PSGOEOS D:$D(Y) ^PSGOETO G DRG
|
|
;
|
|
DONE ;
|
|
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,PSG,PSGDL,PSGDLS,PSGDO,PSGDRG,PSGDRGN,PSGFD,PSGHSM,PSGMR,PSGMRN,PSGNEDFD,PSGNEFD,PSGNESD,PSGNEWDT
|
|
K PSGOEPR,PSGOES,PSGOPR,PSGORD,PSGOROE1,PSGPR,PSGPRN,PSGS0XT,PSGS0Y,PSGSCH,PSGSD,PSGSI,PSGSM,PSGST,PSGSTN,PSGUD,PSGX,PSJNARC,PSJOPC
|
|
Q
|
|
;
|
|
AM ;
|
|
W !!?2,"Answer 'YES' (or press the RETURN key) to enter new UNIT DOSE orders for this",!,"patient. Answer 'NO' (or '^') if there are no new orders for this patient." Q
|