source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDM.m@ 808

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1RMPFDM ;DDC/KAW-DISPLAY SYSTEM STATUS [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**16**;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,!?24,"REMOTE ORDER/ENTRY SYSTEM STATUS"
6 W !,"Station: ",RMPFSTAP,?68,RMPFDAT,!
7 F I=1:1:80 W "-"
8 W !!,?31,"Current",?60,"Messages"
9 W !?6,"Order Status",?31,"Number",?43,"Oldest Date",?60,"To Read"
10 W !,"-------------------------",?30,"--------",?43,"------------",?60,"--------",!
11 S ST=0
12S1 S ST=$O(^RMPF(791810,"AC",ST)) G R3:'ST S (RMPFX,CT,DX)=0,RMPFMGG=""
13 S SP="" I $D(^RMPF(791810.2,ST,0)) S SP=$P(^(0),U,1)
14S2 S RMPFX=$O(^RMPF(791810,"AC",ST,RMPFX)) I 'RMPFX D WRITE G S1
15 G S2:'$D(^RMPF(791810,RMPFX,0)) S S0=^(0)
16 S X=$P(S0,U,15) S:X="" X=0 G S2:X'=$O(^RMPF(791810.5,"C",RMPFMENU,0))
17 G S2:$P($P($G(^RMPF(791810,RMPFX,"STA")),U,1)," - ",1)'=$P(RMPFSTAP," - ",1) S CT=CT+1
18 S D=$P(S0,".",1) S:'DX DX=D I D<DX S DX=D
19 S X=0 F I=1:1 S X=$O(^RMPF(791810,RMPFX,201,X)) Q:'X S Y=0 F J=1:1 S Y=$O(^RMPF(791810,RMPFX,201,X,101,Y)) Q:'Y I $D(^(Y,0)),'$P(^(0),U,6) S RMPFMGG="***" Q
20 G S2
21R3 I IOST?1"P-".E W @IOF G END
22 F I=1:1 Q:$Y>21 W !
23 W !,"Enter <P>rint or <RETURN> to continue." D READ G END:Y=""
24 S Y=$E(Y,1) I "Pp"[Y D QUE
25END K US,PT,MG,NM,CT,LD,I,D,SP,ST,DX,Y,RMPFX,RMPFS,RMPFOUT,RMPFQUT,X
26 K RMPFMGG,J Q
27WRITE Q:'CT S LD="",Y=DX I Y D DD^%DT S LD=Y
28 W !,SP,?30,$J(CT,8),?43,LD,?63,$S(RMPFMGG'="":"YES",1:"NO")
29 Q
30QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
31 I IO=IO(0),'$D(IO("S")) D ^RMPFDM G QUEE
32 I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDM
33 S ZTRTN="^RMPFDM",ZTSAVE("RMPF*")=""
34 S ZTIO=ION D ^%ZTLOAD
35 D HOME^%ZIS S RMPFOUT=""
36 W:$D(ZTSK) !!,"*** Request Queued ***" H 1
37QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK Q
38READ K RMPFOUT,RMPFQUT
39 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
40 I Y?1"^".E S (RMPFOUT,Y)="" Q
41 S:Y?1"?".E (RMPFQUT,Y)=""
42 Q
Note: See TracBrowser for help on using the repository browser.