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