- 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 Feb 19, 2025@00:02:10 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
