source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDS2.m@ 1147

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

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1RMPFDS2 ;DDC/KAW-DISPLAY ORDERS IN ERROR STATUS [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**17**;06/06/01
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 I RMPFMENU=10,$D(^RMPF(791810,"AF")) D G END:$D(RMPFOUT)
6 .W $C(7),@IOF,!?15,"*** ROES ***"
7 .W !?15,"*** ELIGIBILITY DETERMINATIONS AWAITING ACTION ***",!
8 .D ^RMPFDE
9 S (X,FL)=0,MU=$O(^RMPF(791810.5,"C",RMPFMENU,0))
10 G END:'$P(RMPFSYS,U,9),END:'$D(^RMPF(791810,"AC",6))
11 F S X=$O(^RMPF(791810,"AC",6,X)) Q:'X I $D(^RMPF(791810,X,0)),$P(^(0),U,15)=MU S FL=1 Q
12 G END:'FL
13 S RMPFORD="S",RMPFTP="B",RMPFP(6)="" D ^RMPFDS1 G END:$D(RMPFOUT)
14 D CONT^RMPFDS1
15END K X,FL,MU,S0,RMPFORD,RMPFTP,RMPFP,RMPFCX,RMPFDOD,RMPFOUT,RMPFQUT,RMPFS
16 K SS,%XX,%YY,DFN,I,Y,RMPFOUT,RMPFQUT Q
17CONT F Q:$Y>21 W !
18 W !,"Type <RETURN> to continue." D READ Q
19READ K RMPFOUT,RMPFQUT
20 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
21 I Y?1"^".E S (RMPFOUT,Y)="" Q
22 S:Y?1"?".E (RMPFQUT,Y)=""
23 Q
24QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
25 I IO=IO(0),'$D(IO("S")) D ^RMPFDS1,CONT^RMPFDS1 S RMPFOUT="" G QUEE
26 I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDS1
27 S ZTRTN="^RMPFDS1",ZTSAVE("RMPF*")="",ZTSAVE("DFN")=""
28 S ZTSAVE("RMPFP(")="",ZTIO=ION D ^%ZTLOAD
29 D HOME^%ZIS S RMPFOUT=""
30 W:$D(ZTSK) !!,"*** Request Queued ***" H 2
31QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK Q
Note: See TracBrowser for help on using the repository browser.