source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDT.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1RMPFDT ;DDC/KAW-PATIENT ORDER INFORMATION; [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
3RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
4 I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
5 W @IOF,!!,"PATIENT ORDER INFORMATION"
6PAT W ! S DIC=2,DIC(0)="AEQM" D ^DIC G END:Y=-1 K DIC S DFN=+Y
7ORDERS S (RMPFORD,RMPFTP)="P" D ^RMPFDS1 G END:$D(RMPFOUT),PAT:'RMPFCX
8 D SEL G END:$D(RMPFOUT),RMPFSET:'$D(RMPFX)
9 S RMPFHAT="",X=$P(^RMPF(791810,RMPFX,0),U,2) I X,$D(^RMPF(791810.1,X,0)) S RMPFHAT=$P(^(0),U,2)
10ORDERS0 D ^RMPFDT1 G END:$D(RMPFOUT)
11ORDERS1 D CONT G END:$D(RMPFOUT),ORDERS0:$D(RMPFX),RMPFSET
12END K DFN,RMPFORD,RMPFTP,RMPFHAT,Y,RMPFCX,CN,RMPFOUT,RMPFQUT,RMPFX,RMPFO
13 K DISYS,DIC,%,%Y,C,I,J,X,T,CM,L Q
14READ K RMPFOUT,RMPFQUT
15 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
16 I Y?1"^".E S (RMPFOUT,Y)="" Q
17 S:Y?1"?".E (RMPFQUT,Y)=""
18 Q
19CONT F I=1:1 Q:$Y>(IOSL-4) W !
20 W !,"Type <P>rint, E<X>tended"
21 I $O(^RMPF(791810,RMPFX,201,0)) W ", <M>essages"
22 I "CIX"[RMPFHAT W ", <H>istory"
23 I $O(^RMPF(791810,RMPFX,301,0)) W ", <A>uthorized Aids"
24 W:$X>65 ! W " or <RETURN> to continue: " D READ Q:$D(RMPFOUT)
25CONT1 I $D(RMPFQUT) D MSG G CONT1:$D(RMPFQUT) Q
26 I Y="" K RMPFX Q
27 S Y=$E(Y,1) I "Mm"[Y D ^RMPFDT4 Q
28 I "CIX"[RMPFHAT,"Hh"[Y D ^RMPFDT7 Q
29 I "Aa"[Y D ^RMPFDT8 Q
30 I "Xx"[Y D ^RMPFDT9 Q
31 S:Y="p" Y="P" I Y'="P" K I Q
32QUE W ! S %ZIS="QNP" D ^%ZIS G END:POP
33 I IO=IO(0),'$D(IO("S")) D ^RMPFDT1 D QUEE G CONT
34 I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDT1
35 S ZTRTN="^RMPFDT1",ZTSAVE("RMPF*")="",ZTIO=ION D ^%ZTLOAD
36 D HOME^%ZIS W:$D(ZTSK) !!,"*** Request Queued ***" H 2
37QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK Q
38SEL ;;input: RMPFS
39 ;;output: RMPFX
40 K RMPFX F I=1:1 Q:$Y>20 W !
41 W !!!,"Enter the number of the order to view detail or <^> to exit. "
42 D READ G SELE:$D(RMPFOUT)
43S1 I $D(RMPFQUT) W !!,"Enter the number to the left of the order you wish to view or",!?5," an <^> to exit." G SEL
44 G SELE:Y="" I '$D(RMPFS(Y)) S RMPFQUT="" G S1
45 S RMPFX=RMPFS(Y)
46SELE K RMPFS,Y,I Q
47MSG W !!,"Enter <P> to print this screen"
48 W:RMPFTP'="S" !?6,"<X> to view the Extended Information Screen"
49 I $O(^RMPF(791810,RMPFX,201,0)) W !?6,"<M> to view messages for this order"
50 I $P(^RMPF(791810,RMPFX,0),U,2)=2 W !?6,"<H> to view the history of this order"
51 W !?6,"<RETURN> to continue."
52 W !!,"Enter <RETURN> to continue." D READ
53 Q
Note: See TracBrowser for help on using the repository browser.