GECSRST1 ;WISC/RFJ/KLD-stack reports (print) ;22 Dec 93
;;2.0;GCS;**4,15**;MAR 14, 1995
Q
;
;
DQ ; queue comes here
N D,DA,DA1,DATA0,DATA1,GECSFLAG,NOW,PAGE,SCREEN,STATUS,TOTAL,TRANCODE,X,Y,YDT
K ^TMP($J,"GECSRSTA")
S TRANCODE=GECSSTRT F S TRANCODE=$O(^GECS(2100.1,"B",TRANCODE)) Q:TRANCODE=""!($E(TRANCODE,1,2)]GECSEND) D
. S DA=+$O(^GECS(2100.1,"B",TRANCODE,0)) Q:'DA
. S DATA0=$G(^GECS(2100.1,DA,0)) Q:DATA0=""
. I $P(DATA0,"^",3)'>GECSDATE Q
. ; check for confirmation number
. I $G(GECSFALL)!($D(GECSSTAT("N"))) D
. . S DA1=0 F S DA1=$O(^GECS(2100.1,DA,20,DA1)) Q:'DA1 I $P($G(^(DA1,0)),"^",2)="" Q
. . I DA1 S ^TMP($J,"GECSRSTA",DA)=""
. ;
. S STATUS=$P(DATA0,"^",4)
. I '$G(GECSFALL),$L(STATUS),'$D(GECSSTAT(STATUS)) Q
. I '$G(GECSFALL),STATUS="" Q
. S ^TMP($J,"GECSRSTA",DA)=""
;
D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1
S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
U IO D H
S (DA,TOTAL)=0 F S DA=$O(^TMP($J,"GECSRSTA",DA)) Q:'DA!($G(GECSFLAG)) S DATA0=$G(^GECS(2100.1,DA,0)),DATA1=$G(^(1)) D
. I $Y>(IOSL-7) D:$G(SCREEN) PAUSE^GECSUTIL Q:$G(GECSFLAG) D H
. S Y=$P(DATA0,"^",3) D DD^%DT
. S X=$S($P(DATA0,"^",4)="":"",1:$P($P(GECSSSET,$P(DATA0,"^",4)_":",2),";"))
. S TOTAL=TOTAL+1
. W !,$P(DATA0,"^"),?24,Y,?46,X
. I $E(X)="Q" S (Y,YDT)=$P($G(^GECS(2100.1,DA,11)),"^",3) I Y D
. . W " ",$E(YDT,4,5),"-",$E(YDT,6,7),"-"
. . D DD^%DT W $E($P(Y,",",2),2,5)
. I $P(DATA1,"^",3)'="" W !?3,"COUNT: ",$E($P(DATA1,"^",3),1,69)
. I $E(X)="E",$P(DATA1,"^",2)'="" W !?3,"ERROR: ",$E($P(DATA1,"^",2),1,69)
. I GECSDESC=1,$P(DATA1,"^")'="" W !?3,"DESCR: ",$E($P(DATA1,"^"),1,69)
. I $Y>(IOSL-5) D:$G(SCREEN) PAUSE^GECSUTIL Q:$G(GECSFLAG) D H
. I $O(^GECS(2100.1,DA,20,0)) D Q:$G(GECSFLAG)
. . W !?3,"MAIL MSGS: "
. . S DA1=0 F S DA1=$O(^GECS(2100.1,DA,20,DA1)) Q:'DA1!($G(GECSFLAG)) D
. . . I $Y>(IOSL-5) D:$G(SCREEN) PAUSE^GECSUTIL Q:$G(GECSFLAG) D H
. . . W ?14,DA1,?24,"CONFIRMATION: ",$P(^GECS(2100.1,DA,20,DA1,0),"^",2)
. . . I $O(^GECS(2100.1,DA,20,DA1)) W !
. I $Y>(IOSL-5) D:$G(SCREEN) PAUSE^GECSUTIL Q:$G(GECSFLAG) D H
. I $O(^GECS(2100.1,DA,21,0)) D Q:$G(GECSFLAG)
. . W !?3,"*OLD MSGS: "
. . S DA1=0 F S DA1=$O(^GECS(2100.1,DA,21,DA1)) Q:'DA1!($G(GECSFLAG)) D
. . . I $Y>(IOSL-5) D:$G(SCREEN) PAUSE^GECSUTIL Q:$G(GECSFLAG) D H
. . . W ?14,DA1,?24,"CONFIRMATION: ",$P(^GECS(2100.1,DA,21,DA1,0),"^",2)
. . . I $O(^GECS(2100.1,DA,21,DA1)) W !
. I GECSCODE=1 D
. . W !,"*** ACTUAL CODE SHEET:"
. . S DA1=0 F S DA1=$O(^GECS(2100.1,DA,10,DA1)) Q:'DA1!($G(GECSFLAG)) S D=$G(^(DA1,0)) D
. . . I $Y>(IOSL-5) D:$G(SCREEN) PAUSE^GECSUTIL Q:$G(GECSFLAG) D H
. . . W !,D
. . I '$G(GECSFLAG) W !,"*** END OF CODE SHEET ***"
I '$G(GECSFLAG) W !!?10,"TOTAL CODE SHEETS: ",TOTAL
D ^%ZISC
K ^TMP($J,"GECSRSTA")
Q
;
;
H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
W $C(13),"GCS STACK FILE STATUS REPORT",?(80-$L(%)),%
S %="",$P(%,"-",81)=""
W !,"TC-TRAN CODE -BATNUM",?24,"DATE@TIME CREATED",?46,"STATUS",?70,"HOLD DATE",!,%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSRST1 3266 printed Sep 23, 2025@19:32:26 Page 2
GECSRST1 ;WISC/RFJ/KLD-stack reports (print) ;22 Dec 93
+1 ;;2.0;GCS;**4,15**;MAR 14, 1995
+2 QUIT
+3 ;
+4 ;
DQ ; queue comes here
+1 NEW D,DA,DA1,DATA0,DATA1,GECSFLAG,NOW,PAGE,SCREEN,STATUS,TOTAL,TRANCODE,X,Y,YDT
+2 KILL ^TMP($JOB,"GECSRSTA")
+3 SET TRANCODE=GECSSTRT
FOR
SET TRANCODE=$ORDER(^GECS(2100.1,"B",TRANCODE))
if TRANCODE=""!($EXTRACT(TRANCODE,1,2)]GECSEND)
QUIT
Begin DoDot:1
+4 SET DA=+$ORDER(^GECS(2100.1,"B",TRANCODE,0))
if 'DA
QUIT
+5 SET DATA0=$GET(^GECS(2100.1,DA,0))
if DATA0=""
QUIT
+6 IF $PIECE(DATA0,"^",3)'>GECSDATE
QUIT
+7 ; check for confirmation number
+8 IF $GET(GECSFALL)!($DATA(GECSSTAT("N")))
Begin DoDot:2
+9 SET DA1=0
FOR
SET DA1=$ORDER(^GECS(2100.1,DA,20,DA1))
if 'DA1
QUIT
IF $PIECE($GET(^(DA1,0)),"^",2)=""
QUIT
+10 IF DA1
SET ^TMP($JOB,"GECSRSTA",DA)=""
End DoDot:2
+11 ;
+12 SET STATUS=$PIECE(DATA0,"^",4)
+13 IF '$GET(GECSFALL)
IF $LENGTH(STATUS)
IF '$DATA(GECSSTAT(STATUS))
QUIT
+14 IF '$GET(GECSFALL)
IF STATUS=""
QUIT
+15 SET ^TMP($JOB,"GECSRSTA",DA)=""
End DoDot:1
+16 ;
+17 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
SET PAGE=1
+18 SET SCREEN=0
IF '$DATA(ZTQUEUED)
IF IO=IO(0)
IF $EXTRACT(IOST)="C"
SET SCREEN=1
+19 USE IO
DO H
+20 SET (DA,TOTAL)=0
FOR
SET DA=$ORDER(^TMP($JOB,"GECSRSTA",DA))
if 'DA!($GET(GECSFLAG))
QUIT
SET DATA0=$GET(^GECS(2100.1,DA,0))
SET DATA1=$GET(^(1))
Begin DoDot:1
+21 IF $Y>(IOSL-7)
if $GET(SCREEN)
DO PAUSE^GECSUTIL
if $GET(GECSFLAG)
QUIT
DO H
+22 SET Y=$PIECE(DATA0,"^",3)
DO DD^%DT
+23 SET X=$SELECT($PIECE(DATA0,"^",4)="":"",1:$PIECE($PIECE(GECSSSET,$PIECE(DATA0,"^",4)_":",2),";"))
+24 SET TOTAL=TOTAL+1
+25 WRITE !,$PIECE(DATA0,"^"),?24,Y,?46,X
+26 IF $EXTRACT(X)="Q"
SET (Y,YDT)=$PIECE($GET(^GECS(2100.1,DA,11)),"^",3)
IF Y
Begin DoDot:2
+27 WRITE " ",$EXTRACT(YDT,4,5),"-",$EXTRACT(YDT,6,7),"-"
+28 DO DD^%DT
WRITE $EXTRACT($PIECE(Y,",",2),2,5)
End DoDot:2
+29 IF $PIECE(DATA1,"^",3)'=""
WRITE !?3,"COUNT: ",$EXTRACT($PIECE(DATA1,"^",3),1,69)
+30 IF $EXTRACT(X)="E"
IF $PIECE(DATA1,"^",2)'=""
WRITE !?3,"ERROR: ",$EXTRACT($PIECE(DATA1,"^",2),1,69)
+31 IF GECSDESC=1
IF $PIECE(DATA1,"^")'=""
WRITE !?3,"DESCR: ",$EXTRACT($PIECE(DATA1,"^"),1,69)
+32 IF $Y>(IOSL-5)
if $GET(SCREEN)
DO PAUSE^GECSUTIL
if $GET(GECSFLAG)
QUIT
DO H
+33 IF $ORDER(^GECS(2100.1,DA,20,0))
Begin DoDot:2
+34 WRITE !?3,"MAIL MSGS: "
+35 SET DA1=0
FOR
SET DA1=$ORDER(^GECS(2100.1,DA,20,DA1))
if 'DA1!($GET(GECSFLAG))
QUIT
Begin DoDot:3
+36 IF $Y>(IOSL-5)
if $GET(SCREEN)
DO PAUSE^GECSUTIL
if $GET(GECSFLAG)
QUIT
DO H
+37 WRITE ?14,DA1,?24,"CONFIRMATION: ",$PIECE(^GECS(2100.1,DA,20,DA1,0),"^",2)
+38 IF $ORDER(^GECS(2100.1,DA,20,DA1))
WRITE !
End DoDot:3
End DoDot:2
if $GET(GECSFLAG)
QUIT
+39 IF $Y>(IOSL-5)
if $GET(SCREEN)
DO PAUSE^GECSUTIL
if $GET(GECSFLAG)
QUIT
DO H
+40 IF $ORDER(^GECS(2100.1,DA,21,0))
Begin DoDot:2
+41 WRITE !?3,"*OLD MSGS: "
+42 SET DA1=0
FOR
SET DA1=$ORDER(^GECS(2100.1,DA,21,DA1))
if 'DA1!($GET(GECSFLAG))
QUIT
Begin DoDot:3
+43 IF $Y>(IOSL-5)
if $GET(SCREEN)
DO PAUSE^GECSUTIL
if $GET(GECSFLAG)
QUIT
DO H
+44 WRITE ?14,DA1,?24,"CONFIRMATION: ",$PIECE(^GECS(2100.1,DA,21,DA1,0),"^",2)
+45 IF $ORDER(^GECS(2100.1,DA,21,DA1))
WRITE !
End DoDot:3
End DoDot:2
if $GET(GECSFLAG)
QUIT
+46 IF GECSCODE=1
Begin DoDot:2
+47 WRITE !,"*** ACTUAL CODE SHEET:"
+48 SET DA1=0
FOR
SET DA1=$ORDER(^GECS(2100.1,DA,10,DA1))
if 'DA1!($GET(GECSFLAG))
QUIT
SET D=$GET(^(DA1,0))
Begin DoDot:3
+49 IF $Y>(IOSL-5)
if $GET(SCREEN)
DO PAUSE^GECSUTIL
if $GET(GECSFLAG)
QUIT
DO H
+50 WRITE !,D
End DoDot:3
+51 IF '$GET(GECSFLAG)
WRITE !,"*** END OF CODE SHEET ***"
End DoDot:2
End DoDot:1
+52 IF '$GET(GECSFLAG)
WRITE !!?10,"TOTAL CODE SHEETS: ",TOTAL
+53 DO ^%ZISC
+54 KILL ^TMP($JOB,"GECSRSTA")
+55 QUIT
+56 ;
+57 ;
H SET %=NOW_" PAGE "_PAGE
SET PAGE=PAGE+1
IF PAGE'=2!(SCREEN)
WRITE @IOF
+1 WRITE $CHAR(13),"GCS STACK FILE STATUS REPORT",?(80-$LENGTH(%)),%
+2 SET %=""
SET $PIECE(%,"-",81)=""
+3 WRITE !,"TC-TRAN CODE -BATNUM",?24,"DATE@TIME CREATED",?46,"STATUS",?70,"HOLD DATE",!,%
+4 QUIT
