| [613] | 1 | RMPFDT4 ;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
|
|---|
| 10 | A1 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
|
|---|
| 14 | A2 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
|
|---|
| 24 | EXIT 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
|
|---|
| 33 | END 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
|
|---|
| 35 | HEAD 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
|
|---|
| 44 | CONT F I=1:1 Q:$Y>20 W !
|
|---|
| 45 | W !,"Type <P>rint or <RETURN> to continue: " D READ
|
|---|
| 46 | Q:$D(RMPFOUT)
|
|---|
| 47 | CONT1 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
|
|---|
| 49 | QUE 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
|
|---|
| 55 | QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO Q
|
|---|
| 56 | READ 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
|
|---|
