source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDT4.m@ 1211

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1RMPFDT4 ;DDC/KAW-DISPLAY ORDER MESSAGES [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
3 ;;input : RMPFX
4 ;;output: None
5 Q:'$D(RMPFX) I $D(DFN),DFN D PAT^RMPFUTL
6 S Y=$P(^RMPF(791810,RMPFX,0),U,1),%DT="T" D DD^%DT S TT=Y
7 S TP=$P(^RMPF(791810,RMPFX,0),U,2)
8 I TP,$D(^RMPF(791810.1,TP,0)) S TP=$P(^(0),U,1)
9 S (CM,CX)=0 D HEAD
10A1 S CM=$O(^RMPF(791810,RMPFX,201,CM)) G EXIT:'CM,A1:'$D(^(CM,0)) S S0=^(0),RMPFMD=""
11 S Y=$P(S0,U,5) I Y D DD^%DT S RMPFMD=Y
12 I RMPFMD="" S Y=$P(^RMPF(791810,RMPFX,201,CM,0),".",1) D DD^%DT S RMPFMD=Y
13 S CE=0
14A2 S CE=$O(^RMPF(791810,RMPFX,201,CM,101,CE)) G A1:'CE G A2:'$D(^(CE,0)) S S1=^(0),MG=$P(S1,U,1),PR=$P(S1,U,2),Y=$P(S1,U,10) D DD^%DT S SD=Y
15 S EX=$P(S1,U,3),ST=$P(S1,U,4),LR=$P(S1,U,7)
16 I IOST?1"C-".E,$Y>20 D CONT G END:$D(ZTSK) D HEAD
17 I IOST?1"P-".E,$Y>58 W @IOF D HEAD
18 I LR,$D(^VA(200,LR,0)) S LR=$E($P(^(0),U,2),1,4)
19 W !!,RMPFMD,?15,$E(PR,1,17),?35,EX
20 I ST W ?52,$S($D(^RMPF(791810.2,ST,0)):$P(^(0),U,4),1:"")
21 W ?61,SD,?76,LR
22 W !?3,"Message: ",$E(MG,1,66) S CX=CX+1
23 G A2
24EXIT W:CX=0 !!,"*** NO MESSAGES TO DISPLAY ***"
25 I CX S XX=0 F I=1:1 S XX=$O(^RMPF(791810,RMPFX,201,XX)) Q:'XX S YY=0 F J=1:1 S YY=$O(^RMPF(791810,RMPFX,201,XX,101,YY)) Q:'YY D
26 .S DIE="^RMPF(791810,"_RMPFX_",201,"_XX_",101,"
27 .S DA(2)=RMPFX,DA(1)=XX,DA=YY
28 .S DR=".06////1;.07////"_DUZ D ^DIE
29 .K DR,DA,DIE,D,D0,DQ Q
30 I IOST?1"C-".E D CONT G END:$D(RMPFOUT),END:'$D(Y),END:Y="",RMPFDT4
31 I IOST?1"P-".E W @IOF
32 D:$D(IO("S")) ^%ZISC
33END K I,CM,CX,S0,Y,X,%,%DT,%Y,RMPFMD,CE,S1,MG,PR,EX,ST,SD,RMPFNAM,RMPFDOB
34 K RMPFSSN,TT,TP,LR,DI,DIC,XX,YY,J,ZTSK,%XX,%YY Q
35HEAD W:IOST?1"C-".E @IOF W !?32,"MESSAGE UPDATES"
36 W !,"Station: ",RMPFSTAP,?68,RMPFDAT
37 I $D(RMPFNAM) W !,"Patient: ",$E(RMPFNAM,1,25),?40,"SSN: ",RMPFSSN,?62,"DOB: ",RMPFDOB
38 W !?2,"Order: ",TP,!?3,"Date: ",TT
39 W ! F I=1:1:80 W "-"
40 W !?4,"DDC",?76,"Last"
41 W !,"Process Date",?20,"Sender",?37,"Telephone",?52,"Status",?62,"Ship Date",?76,"Read"
42 W !,"------------",?15,"-----------------",?35,"--------------",?52,"------",?61,"------------",?76,"----"
43 Q
44CONT F I=1:1 Q:$Y>20 W !
45 W !,"Type <P>rint or <RETURN> to continue: " D READ
46 Q:$D(RMPFOUT)
47CONT1 I $D(RMPFQUT) K RMPFQUT D MSG^RMPFDD G CONT1:$D(RMPFQUT) Q
48 Q:Y="" S Y=$E(Y,1) I "Pp"'[Y S RMPFQUT="" G CONT1
49QUE W ! S %ZIS="QNP" D ^%ZIS G END:POP
50 I IO=IO(0),'$D(IO("S")) D QUEE S Y=1 Q
51 I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDT4
52 S ZTRTN="^RMPFDT4",ZTSAVE("RMPF*")="",ZTSAVE("DFN")="",ZTIO=ION
53 D ^%ZTLOAD
54 D HOME^%ZIS W:$D(ZTSK) !!,"*** Request Queued ***" H 2
55QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO Q
56READ K RMPFOUT,RMPFQUT
57 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
58 I Y?1"^".E S (RMPFOUT,Y)="" Q
59 S:Y?1"?".E (RMPFQUT,Y)=""
60 Q
Note: See TracBrowser for help on using the repository browser.