- 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 Mar 13, 2025@21:01 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
