RMPFDT4 ;DDC/KAW-DISPLAY ORDER MESSAGES [ 06/16/95 3:06 PM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
;;input : RMPFX
;;output: None
Q:'$D(RMPFX) I $D(DFN),DFN D PAT^RMPFUTL
S Y=$P(^RMPF(791810,RMPFX,0),U,1),%DT="T" D DD^%DT S TT=Y
S TP=$P(^RMPF(791810,RMPFX,0),U,2)
I TP,$D(^RMPF(791810.1,TP,0)) S TP=$P(^(0),U,1)
S (CM,CX)=0 D HEAD
A1 S CM=$O(^RMPF(791810,RMPFX,201,CM)) G EXIT:'CM,A1:'$D(^(CM,0)) S S0=^(0),RMPFMD=""
S Y=$P(S0,U,5) I Y D DD^%DT S RMPFMD=Y
I RMPFMD="" S Y=$P(^RMPF(791810,RMPFX,201,CM,0),".",1) D DD^%DT S RMPFMD=Y
S CE=0
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
S EX=$P(S1,U,3),ST=$P(S1,U,4),LR=$P(S1,U,7)
I IOST?1"C-".E,$Y>20 D CONT G END:$D(ZTSK) D HEAD
I IOST?1"P-".E,$Y>58 W @IOF D HEAD
I LR,$D(^VA(200,LR,0)) S LR=$E($P(^(0),U,2),1,4)
W !!,RMPFMD,?15,$E(PR,1,17),?35,EX
I ST W ?52,$S($D(^RMPF(791810.2,ST,0)):$P(^(0),U,4),1:"")
W ?61,SD,?76,LR
W !?3,"Message: ",$E(MG,1,66) S CX=CX+1
G A2
EXIT W:CX=0 !!,"*** NO MESSAGES TO DISPLAY ***"
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
.S DIE="^RMPF(791810,"_RMPFX_",201,"_XX_",101,"
.S DA(2)=RMPFX,DA(1)=XX,DA=YY
.S DR=".06////1;.07////"_DUZ D ^DIE
.K DR,DA,DIE,D,D0,DQ Q
I IOST?1"C-".E D CONT G END:$D(RMPFOUT),END:'$D(Y),END:Y="",RMPFDT4
I IOST?1"P-".E W @IOF
D:$D(IO("S")) ^%ZISC
END K I,CM,CX,S0,Y,X,%,%DT,%Y,RMPFMD,CE,S1,MG,PR,EX,ST,SD,RMPFNAM,RMPFDOB
K RMPFSSN,TT,TP,LR,DI,DIC,XX,YY,J,ZTSK,%XX,%YY Q
HEAD W:IOST?1"C-".E @IOF W !?32,"MESSAGE UPDATES"
W !,"Station: ",RMPFSTAP,?68,RMPFDAT
I $D(RMPFNAM) W !,"Patient: ",$E(RMPFNAM,1,25),?40,"SSN: ",RMPFSSN,?62,"DOB: ",RMPFDOB
W !?2,"Order: ",TP,!?3,"Date: ",TT
W ! F I=1:1:80 W "-"
W !?4,"DDC",?76,"Last"
W !,"Process Date",?20,"Sender",?37,"Telephone",?52,"Status",?62,"Ship Date",?76,"Read"
W !,"------------",?15,"-----------------",?35,"--------------",?52,"------",?61,"------------",?76,"----"
Q
CONT F I=1:1 Q:$Y>20 W !
W !,"Type <P>rint or <RETURN> to continue: " D READ
Q:$D(RMPFOUT)
CONT1 I $D(RMPFQUT) K RMPFQUT D MSG^RMPFDD G CONT1:$D(RMPFQUT) Q
Q:Y="" S Y=$E(Y,1) I "Pp"'[Y S RMPFQUT="" G CONT1
QUE W ! S %ZIS="QNP" D ^%ZIS G END:POP
I IO=IO(0),'$D(IO("S")) D QUEE S Y=1 Q
I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDT4
S ZTRTN="^RMPFDT4",ZTSAVE("RMPF*")="",ZTSAVE("DFN")="",ZTIO=ION
D ^%ZTLOAD
D HOME^%ZIS W:$D(ZTSK) !!,"*** Request Queued ***" H 2
QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO Q
READ K RMPFOUT,RMPFQUT
R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
I Y?1"^".E S (RMPFOUT,Y)="" Q
S:Y?1"?".E (RMPFQUT,Y)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFDT4 2777 printed Oct 16, 2024@18:36:37 Page 2
RMPFDT4 ;DDC/KAW-DISPLAY ORDER MESSAGES [ 06/16/95 3:06 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
+2 ;;input : RMPFX
+3 ;;output: None
+4 if '$DATA(RMPFX)
QUIT
IF $DATA(DFN)
IF DFN
DO PAT^RMPFUTL
+5 SET Y=$PIECE(^RMPF(791810,RMPFX,0),U,1)
SET %DT="T"
DO DD^%DT
SET TT=Y
+6 SET TP=$PIECE(^RMPF(791810,RMPFX,0),U,2)
+7 IF TP
IF $DATA(^RMPF(791810.1,TP,0))
SET TP=$PIECE(^(0),U,1)
+8 SET (CM,CX)=0
DO HEAD
A1 SET CM=$ORDER(^RMPF(791810,RMPFX,201,CM))
if 'CM
GOTO EXIT
if '$DATA(^(CM,0))
GOTO A1
SET S0=^(0)
SET RMPFMD=""
+1 SET Y=$PIECE(S0,U,5)
IF Y
DO DD^%DT
SET RMPFMD=Y
+2 IF RMPFMD=""
SET Y=$PIECE(^RMPF(791810,RMPFX,201,CM,0),".",1)
DO DD^%DT
SET RMPFMD=Y
+3 SET CE=0
A2 SET CE=$ORDER(^RMPF(791810,RMPFX,201,CM,101,CE))
if 'CE
GOTO A1
if '$DATA(^(CE,0))
GOTO A2
SET S1=^(0)
SET MG=$PIECE(S1,U,1)
SET PR=$PIECE(S1,U,2)
SET Y=$PIECE(S1,U,10)
DO DD^%DT
SET SD=Y
+1 SET EX=$PIECE(S1,U,3)
SET ST=$PIECE(S1,U,4)
SET LR=$PIECE(S1,U,7)
+2 IF IOST?1"C-".E
IF $Y>20
DO CONT
if $DATA(ZTSK)
GOTO END
DO HEAD
+3 IF IOST?1"P-".E
IF $Y>58
WRITE @IOF
DO HEAD
+4 IF LR
IF $DATA(^VA(200,LR,0))
SET LR=$EXTRACT($PIECE(^(0),U,2),1,4)
+5 WRITE !!,RMPFMD,?15,$EXTRACT(PR,1,17),?35,EX
+6 IF ST
WRITE ?52,$SELECT($DATA(^RMPF(791810.2,ST,0)):$PIECE(^(0),U,4),1:"")
+7 WRITE ?61,SD,?76,LR
+8 WRITE !?3,"Message: ",$EXTRACT(MG,1,66)
SET CX=CX+1
+9 GOTO A2
EXIT if CX=0
WRITE !!,"*** NO MESSAGES TO DISPLAY ***"
+1 IF CX
SET XX=0
FOR I=1:1
SET XX=$ORDER(^RMPF(791810,RMPFX,201,XX))
if 'XX
QUIT
SET YY=0
FOR J=1:1
SET YY=$ORDER(^RMPF(791810,RMPFX,201,XX,101,YY))
if 'YY
QUIT
Begin DoDot:1
+2 SET DIE="^RMPF(791810,"_RMPFX_",201,"_XX_",101,"
+3 SET DA(2)=RMPFX
SET DA(1)=XX
SET DA=YY
+4 SET DR=".06////1;.07////"_DUZ
DO ^DIE
+5 KILL DR,DA,DIE,D,D0,DQ
QUIT
End DoDot:1
+6 IF IOST?1"C-".E
DO CONT
if $DATA(RMPFOUT)
GOTO END
if '$DATA(Y)
GOTO END
if Y=""
GOTO END
GOTO RMPFDT4
+7 IF IOST?1"P-".E
WRITE @IOF
+8 if $DATA(IO("S"))
DO ^%ZISC
END KILL I,CM,CX,S0,Y,X,%,%DT,%Y,RMPFMD,CE,S1,MG,PR,EX,ST,SD,RMPFNAM,RMPFDOB
+1 KILL RMPFSSN,TT,TP,LR,DI,DIC,XX,YY,J,ZTSK,%XX,%YY
QUIT
HEAD if IOST?1"C-".E
WRITE @IOF
WRITE !?32,"MESSAGE UPDATES"
+1 WRITE !,"Station: ",RMPFSTAP,?68,RMPFDAT
+2 IF $DATA(RMPFNAM)
WRITE !,"Patient: ",$EXTRACT(RMPFNAM,1,25),?40,"SSN: ",RMPFSSN,?62,"DOB: ",RMPFDOB
+3 WRITE !?2,"Order: ",TP,!?3,"Date: ",TT
+4 WRITE !
FOR I=1:1:80
WRITE "-"
+5 WRITE !?4,"DDC",?76,"Last"
+6 WRITE !,"Process Date",?20,"Sender",?37,"Telephone",?52,"Status",?62,"Ship Date",?76,"Read"
+7 WRITE !,"------------",?15,"-----------------",?35,"--------------",?52,"------",?61,"------------",?76,"----"
+8 QUIT
CONT FOR I=1:1
if $Y>20
QUIT
WRITE !
+1 WRITE !,"Type <P>rint or <RETURN> to continue: "
DO READ
+2 if $DATA(RMPFOUT)
QUIT
CONT1 IF $DATA(RMPFQUT)
KILL RMPFQUT
DO MSG^RMPFDD
if $DATA(RMPFQUT)
GOTO CONT1
QUIT
+1 if Y=""
QUIT
SET Y=$EXTRACT(Y,1)
IF "Pp"'[Y
SET RMPFQUT=""
GOTO CONT1
QUE WRITE !
SET %ZIS="QNP"
DO ^%ZIS
if POP
GOTO END
+1 IF IO=IO(0)
IF '$DATA(IO("S"))
DO QUEE
SET Y=1
QUIT
+2 IF $DATA(IO("S"))
SET %ZIS=""
SET IOP=ION
DO ^%ZIS
GOTO ^RMPFDT4
+3 SET ZTRTN="^RMPFDT4"
SET ZTSAVE("RMPF*")=""
SET ZTSAVE("DFN")=""
SET ZTIO=ION
+4 DO ^%ZTLOAD
+5 DO HOME^%ZIS
if $DATA(ZTSK)
WRITE !!,"*** Request Queued ***"
HANG 2
QUEE KILL %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO
QUIT
READ KILL RMPFOUT,RMPFQUT
+1 READ Y:DTIME
IF '$TEST
WRITE $CHAR(7)
READ Y:5
if Y="."
GOTO READ
if '$TEST
SET Y=U
+2 IF Y?1"^".E
SET (RMPFOUT,Y)=""
QUIT
+3 if Y?1"?".E
SET (RMPFQUT,Y)=""
+4 QUIT
