RMPFDB ;DDC/KAW-DISPLAY TRANSMISSION BATCH; [ 09/03/97 3:41 PM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;**8**;MAY 30, 1995
RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
W @IOF,!,"DISPLAY TRANSMISSION BATCH" K ZTSK
I '$D(^RMPF(791812,"C")) W !!,"*** NO BATCHES HAVE BEEN CREATED ***" G END
S X=0 F I=1:1 S X=$O(^RMPF(791812,"C",1,X)) Q:'X I X,$D(^RMPF(791812,X,0)),$P(^(0),U,8)=RMPFSTAP S M=$P(^(0),U,9) S:M M=$P($G(^RMPF(791810.5,M,0)),U,2) S:M="" M=1 I M=RMPFMENU Q
G A1:X
A0 W !!,"No open batches.",!!,"Display another batch? NO// "
D READ G END:$D(RMPFOUT)
A01 I $D(RMPFQUT) W !!,"Type <Y> to see a list of batches, <N> or <RETURN> to exit." G A0
G END:Y=""!("Nn"[Y) I "Yy"'[Y S RMPFQUT="" G A01
G A2
A1 W !!,"Display currently open batch? " D READ G END:$D(RMPFOUT)
A11 I $D(RMPFQUT) W !!,"Enter <Y> to display the currently open batch,",!?6,"<N> to view a list of batches no longer open or",!?6,"<RETURN> to exit." G A1
G END:Y="" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G A11
I "Yy"[Y S RMPFBT=X G GO
A2 K RMPFBT D DISP G END:$D(RMPFOUT),GO:$D(RMPFBT)
I '$D(RMPFB) W !!,"*** NO BATCHES EXIST ***" G END
D SEL G END:$D(RMPFOUT)!'$D(RMPFBT)
GO K RMPFB D ^RMPFDB1 G END:$D(RMPFOUT),RMPFSET:$D(ZTSK) D CONT^RMPFDB1
I '$D(RMPFOUT) G RMPFSET
END K RMPFBT,ZTRTN,ZTSAVE,ZTDESC,RMPFOUT,RMPFQUT,RMPFT,RMPFB,POP
K RMPFDOD,ZTSK,%T,%DT,I,X,Y,M 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
DISP ;; input: RMPFS(opt.)
;;output: RMPFB
D HEAD1 S (CT,A)=0 K RMPFB,RMPFBT
D1 S A=$O(^RMPF(791812,"AC",A)) G D3:'A S B=0
D2 S B=$O(^RMPF(791812,"AC",A,B)) G D1:'B
G D2:'$D(^RMPF(791812,B,0)) S S0=^(0) G D2:$P(S0,U,8)'=RMPFSTAP
S M=$P(S0,U,9) S:M M=$P(^RMPF(791810.5,M,0),U,2) S:M="" M=0 G D2:M'=RMPFMENU
S Y=$P(S0,U,1) D DD^%DT S RMPFBDT=Y
S X=$P(S0,U,2) I $D(RMPFS) G D2:'$D(RMPFS(X))
S RMPFBST=$S(X=1:"OPEN",X=2:"CLOSED",X=3:"TRANSMITTED",X=4:"QUEUED FOR TRANSMISSION",1:"")
S RMPFBNA=$P(S0,U,4),(RMPFBTC,RMPFBUS)="" G D2:RMPFBST="OPEN"
S Y=$P(S0,U,3) I Y?7N.E D DD^%DT S RMPFBTC=Y
S X=$P(S0,U,5) I X,$D(^VA(200,X,0)) S RMPFBUS=$P(^(0),U,1)
S CT=CT+1 I $Y>20 D SEL G D3:$D(RMPFOUT),D3:$D(RMPFBT) D HEAD1
W !,$J(CT,2),". ",RMPFBDT,?24,$E(RMPFBST,1,15),?41,$J(RMPFBNA,3),?46,RMPFBTC,?66,$E(RMPFBUS,1,14) S RMPFB(CT)=B
G D2
D3 K A,B,M,X,Y,%DT,CT,S0,RMPFBDT,RMPFBST,RMPFBNA,RMPFBTC,RMPFBUS Q
SEL K RMPFBT W !!,"Select Batch Number: " D READ G SELE:$D(RMPFOUT)
SEL1 I $D(RMPFQUT) W !!,"Enter the number to the left of the batch you wish to choose or",!?10,"<RETURN> to continue." G SEL
G SELE:Y="" I '$D(RMPFB(Y)) S RMPFQUT="" G SEL1
S RMPFBT=RMPFB(Y)
SELE K Y Q
HEAD1 W @IOF,!?23,"REMOTE ORDER/ENTRY ORDER BATCHES"
W !?42,"#"
W !," #",?5,"Batch Date/Time",?25,"Batch Status",?41,"Act",?47,"Date/Time Closed",?68,"Closed By"
W !,"---",?4,"------------------",?24,"---------------",?41,"---",?46,"------------------",?66,"--------------"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFDB 3183 printed Dec 13, 2024@02:35:39 Page 2
RMPFDB ;DDC/KAW-DISPLAY TRANSMISSION BATCH; [ 09/03/97 3:41 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**8**;MAY 30, 1995
RMPFSET ;;RMPFMENU must be defined
IF '$DATA(RMPFMENU)
DO MENU^RMPFUTL
IF '$DATA(RMPFMENU)
WRITE !!,$CHAR(7),"*** A MENU SELECTION MUST BE MADE ***"
QUIT
+1 IF '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
DO ^RMPFUTL
if '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
QUIT
+2 WRITE @IOF,!,"DISPLAY TRANSMISSION BATCH"
KILL ZTSK
+3 IF '$DATA(^RMPF(791812,"C"))
WRITE !!,"*** NO BATCHES HAVE BEEN CREATED ***"
GOTO END
+4 SET X=0
FOR I=1:1
SET X=$ORDER(^RMPF(791812,"C",1,X))
if 'X
QUIT
IF X
IF $DATA(^RMPF(791812,X,0))
IF $PIECE(^(0),U,8)=RMPFSTAP
SET M=$PIECE(^(0),U,9)
if M
SET M=$PIECE($GET(^RMPF(791810.5,M,0)),U,2)
if M=""
SET M=1
IF M=RMPFMENU
QUIT
+5 if X
GOTO A1
A0 WRITE !!,"No open batches.",!!,"Display another batch? NO// "
+1 DO READ
if $DATA(RMPFOUT)
GOTO END
A01 IF $DATA(RMPFQUT)
WRITE !!,"Type <Y> to see a list of batches, <N> or <RETURN> to exit."
GOTO A0
+1 if Y=""!("Nn"[Y)
GOTO END
IF "Yy"'[Y
SET RMPFQUT=""
GOTO A01
+2 GOTO A2
A1 WRITE !!,"Display currently open batch? "
DO READ
if $DATA(RMPFOUT)
GOTO END
A11 IF $DATA(RMPFQUT)
WRITE !!,"Enter <Y> to display the currently open batch,",!?6,"<N> to view a list of batches no longer open or",!?6,"<RETURN> to exit."
GOTO A1
+1 if Y=""
GOTO END
SET Y=$EXTRACT(Y,1)
IF "YyNn"'[Y
SET RMPFQUT=""
GOTO A11
+2 IF "Yy"[Y
SET RMPFBT=X
GOTO GO
A2 KILL RMPFBT
DO DISP
if $DATA(RMPFOUT)
GOTO END
if $DATA(RMPFBT)
GOTO GO
+1 IF '$DATA(RMPFB)
WRITE !!,"*** NO BATCHES EXIST ***"
GOTO END
+2 DO SEL
if $DATA(RMPFOUT)!'$DATA(RMPFBT)
GOTO END
GO KILL RMPFB
DO ^RMPFDB1
if $DATA(RMPFOUT)
GOTO END
if $DATA(ZTSK)
GOTO RMPFSET
DO CONT^RMPFDB1
+1 IF '$DATA(RMPFOUT)
GOTO RMPFSET
END KILL RMPFBT,ZTRTN,ZTSAVE,ZTDESC,RMPFOUT,RMPFQUT,RMPFT,RMPFB,POP
+1 KILL RMPFDOD,ZTSK,%T,%DT,I,X,Y,M
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
DISP ;; input: RMPFS(opt.)
+1 ;;output: RMPFB
+2 DO HEAD1
SET (CT,A)=0
KILL RMPFB,RMPFBT
D1 SET A=$ORDER(^RMPF(791812,"AC",A))
if 'A
GOTO D3
SET B=0
D2 SET B=$ORDER(^RMPF(791812,"AC",A,B))
if 'B
GOTO D1
+1 if '$DATA(^RMPF(791812,B,0))
GOTO D2
SET S0=^(0)
if $PIECE(S0,U,8)'=RMPFSTAP
GOTO D2
+2 SET M=$PIECE(S0,U,9)
if M
SET M=$PIECE(^RMPF(791810.5,M,0),U,2)
if M=""
SET M=0
if M'=RMPFMENU
GOTO D2
+3 SET Y=$PIECE(S0,U,1)
DO DD^%DT
SET RMPFBDT=Y
+4 SET X=$PIECE(S0,U,2)
IF $DATA(RMPFS)
if '$DATA(RMPFS(X))
GOTO D2
+5 SET RMPFBST=$SELECT(X=1:"OPEN",X=2:"CLOSED",X=3:"TRANSMITTED",X=4:"QUEUED FOR TRANSMISSION",1:"")
+6 SET RMPFBNA=$PIECE(S0,U,4)
SET (RMPFBTC,RMPFBUS)=""
if RMPFBST="OPEN"
GOTO D2
+7 SET Y=$PIECE(S0,U,3)
IF Y?7N.E
DO DD^%DT
SET RMPFBTC=Y
+8 SET X=$PIECE(S0,U,5)
IF X
IF $DATA(^VA(200,X,0))
SET RMPFBUS=$PIECE(^(0),U,1)
+9 SET CT=CT+1
IF $Y>20
DO SEL
if $DATA(RMPFOUT)
GOTO D3
if $DATA(RMPFBT)
GOTO D3
DO HEAD1
+10 WRITE !,$JUSTIFY(CT,2),". ",RMPFBDT,?24,$EXTRACT(RMPFBST,1,15),?41,$JUSTIFY(RMPFBNA,3),?46,RMPFBTC,?66,$EXTRACT(RMPFBUS,1,14)
SET RMPFB(CT)=B
+11 GOTO D2
D3 KILL A,B,M,X,Y,%DT,CT,S0,RMPFBDT,RMPFBST,RMPFBNA,RMPFBTC,RMPFBUS
QUIT
SEL KILL RMPFBT
WRITE !!,"Select Batch Number: "
DO READ
if $DATA(RMPFOUT)
GOTO SELE
SEL1 IF $DATA(RMPFQUT)
WRITE !!,"Enter the number to the left of the batch you wish to choose or",!?10,"<RETURN> to continue."
GOTO SEL
+1 if Y=""
GOTO SELE
IF '$DATA(RMPFB(Y))
SET RMPFQUT=""
GOTO SEL1
+2 SET RMPFBT=RMPFB(Y)
SELE KILL Y
QUIT
HEAD1 WRITE @IOF,!?23,"REMOTE ORDER/ENTRY ORDER BATCHES"
+1 WRITE !?42,"#"
+2 WRITE !," #",?5,"Batch Date/Time",?25,"Batch Status",?41,"Act",?47,"Date/Time Closed",?68,"Closed By"
+3 WRITE !,"---",?4,"------------------",?24,"---------------",?41,"---",?46,"------------------",?66,"--------------"
+4 QUIT
