source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDX.m@ 1407

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1RMPFDX ;DDC/KAW-STATION 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,!,"STATION ORDER INFORMATION" H 1
6LIST S RMPFP="*",(RMPFORD,RMPFTP)="S" D ^RMPFDS1 K RMPFX D SEL:RMPFCX
7 G END:$D(RMPFOUT)!'$D(RMPFX)
8START D DISP,CONT G END:$D(RMPFOUT),START:$D(RMPFX),LIST
9END K RMPFO,RMPFP,RMPFORD,RMPFTP,RMPFX,RMPFCX,RMPFOUT,RMPFQUT,RMPFS
10 K T,J,L,Y,DFN,RMPFERR Q
11CONT F I=1:1 Q:$Y>(IOSL-4) W !
12 W !!,"Type <P>rint,"
13 I $O(^RMPF(791810,RMPFX,201,0)) W " <M>essages,"
14 W " <RETURN> to continue or <^> to exit: " D READ K I
15 I $D(RMPFOUT) K Y Q
16 I $D(RMPFQUT) D MSG^RMPFDT Q
17 I Y="" K RMPFX Q
18 S Y=$E(Y,1) I "Pp"[Y D QUE K RMPFX Q
19 I "mM"[Y D ^RMPFDT4 K RMPFX Q
20QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP I IO=IO(0),'$D(IO("S")) D DISP,CONT G QUEE
21 I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G DISP^RMPFDX
22 S ZTRTN="DISP^RMPFDX",ZTSAVE("RMPF*")="",ZTIO=ION
23 S ZTDESC="STATION ORDER INFO" D ^%ZTLOAD D HOME^%ZIS
24 W:$D(ZTSK) !!,"*** Request Queued ***" H 2
25QUEE K %,%T,%ZIS,POP,Y1,ZTSK,ZTDESC,ZTRTN,ZTIO,ZTSAVE Q
26READ K RMPFOUT,RMPFQUT
27 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
28 I Y?1"^".E S (RMPFOUT,Y)="" Q
29 S:Y?1"?".E (RMPFQUT,Y)=""
30 Q
31DISP D ^RMPFDT1
32 Q
33SEL W !!,"Select Order Number or <RETURN> to exit: " D READ
34 Q:$D(RMPFOUT)
35SEL1 I $D(RMPFQUT) W !!,"Type the number of the order you wish to view or <RETURN> to continue." G SEL
36 Q:Y="" I '$D(RMPFS(Y)) S RMPFQUT="" G SEL1
37 S RMPFX=RMPFS(Y) Q
Note: See TracBrowser for help on using the repository browser.