source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOE0.m@ 1353

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1PSGOE0 ;BIR/CML3-PROFILE AND ORDER ENTRY ;25 SEP 97 / 7:42 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**110**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA #2191.
5 ; Reference to ^PS(51.2 is supported by DBIA# 2178.
6 ;
7START ; print orders
8 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
9 ;
10ENVO ; view/act on orders
11 S PSGLMT=PSGON D ENASR^PSGON G:"^"[X ASK G:X["^^" DONE
12 I X="D" D EN^PSGOECS G:'$D(X) ENVO S X="^PROFILE" G START
13 I X="R" D EN^PSGOERS G:'$D(X) ENVO S X="^PROFILE" G START
14 I X="V" D EN^PSGOEVS G:'$D(X) ENVO S X="^PROFILE" G START
15 I X="F" D EN^PSGOESF G:'$D(X) ENVO S X="^PROFILE" G START
16 I PSGODDD S PSGOEA=""
17 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)["^")
18 .Q:$G(PSGOEA)["^" I $D(PSGPRF) W !!,"Press RETURN to continue: " R CONT:DTIME W @IOF S:CONT["^" PSGOEA="^"
19 .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)
20 ;
21 ;
22ASK ; new orders entered here
23 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
24 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)," ??"
25 W:"Nn"[X " (NO)" G:"^Nn"[X DONE W " (YES)"
26 I '$P(PSJSYSU,";",2) S PR=$P($G(^PS(55,PSGP,5.1)),"^",2) I PR D
27 .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=""
28 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
29 ;
30DRG ;
31 D ^PSGOE7 G:Y<0 DONE G:$P("^PROFILE",X)="" START I X?1"S."1.E D ^PSGOES G DRG
32 W ! D ^PSGOE3:$P(PSJSYSP0,"^",12),^PSGOE4:'$P(PSJSYSP0,"^",12) K PSGOEE,PSGOEOS D:$D(Y) ^PSGOETO G DRG
33 ;
34DONE ;
35 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,PSG,PSGDL,PSGDLS,PSGDO,PSGDRG,PSGDRGN,PSGFD,PSGHSM,PSGMR,PSGMRN,PSGNEDFD,PSGNEFD,PSGNESD,PSGNEWDT
36 K PSGOEPR,PSGOES,PSGOPR,PSGORD,PSGOROE1,PSGPR,PSGPRN,PSGS0XT,PSGS0Y,PSGSCH,PSGSD,PSGSI,PSGSM,PSGST,PSGSTN,PSGUD,PSGX,PSJNARC,PSJOPC
37 Q
38 ;
39AM ;
40 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
Note: See TracBrowser for help on using the repository browser.