ECXXREV ;ALB/JAP,BIR/DMA-Status Report from the Extract Log ; [ 05/29/96 5:38 PM ]
;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
EN ;entry point from option
N EC,EC0,ECM,ECXDIQ,X,Y,DIC,DIQ,DR,POP
S DIC=727,DIC(0)="AEQMZ" D ^DIC K DIC
Q:Y<0
S EC=+Y,EC0=Y(0)
D SHOW
K IO("Q") S %ZIS="Q" D ^%ZIS K %ZIS
Q:POP
I $D(IO("Q")) D Q
.S ZTSAVE("EC")="",ZTSAVE("EC0")="",ZTDESC="DSS Extract Status Report",ZTRTN="START^ECXXREV"
.D ^%ZTLOAD
D START W !!
G EN
Q
;
START ;queued entry
N ECXDIQ,ECXRUN,C,L,LN,PG,QFLG
U IO
S $P(LN,"-",80)="",PG=0,QFLG=0
D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
D HDR
D SHOW
W !,"Purged: ",$S(ECXDIQ(727,EC,9,"E")]"":ECXDIQ(727,EC,9,"E"),1:"(Not purged)")
W !,"Transmitted: ",$S(ECXDIQ(727,EC,300,"E")]"":ECXDIQ(727,EC,300,"E"),1:"(Not transmitted)")
I ECXDIQ(727,EC,300,"E")]"" D
.I '$O(^ECX(727,EC,1,0)) W !,"All transmission messages confirmed." Q
.W !,"Unconfirmed transmission message numbers --"
.F ECM=0:0 S ECM=$O(^ECX(727,EC,1,ECM)) Q:'ECM D Q:QFLG
..W !,ECM
..S ECM=$O(^ECX(727,EC,1,ECM)) I 'ECM S QFLG=1 Q
..W ?20,ECM
..S ECM=$O(^ECX(727,EC,1,ECM)) I 'ECM S QFLG=1 Q
..W ?40,ECM
..I $Y+3>IOSL D HDR Q:QFLG
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
Q
;
HDR ;header
N JJ,SS
I $E(IOST)="C" D
.S SS=22-$Y F JJ=1:1:SS W !
.I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
Q:QFLG
W:$Y @IOF S PG=PG+1
W !,"Status Report for DSS Extract #",EC," ("_$P(EC0,U,3)_")"
I $E(IOST)'="C" W !,"Printed: ",ECXRUN,?68,"Page: ",PG
W !,LN
I PG>1 W !,"Unconfirmed transmission message numbers (con.t) --",!
Q
;
SHOW ;get data on extract
S DIC="^ECX(727,",DR="1;6;3;4;5;9;15;300",DA=+EC,DIQ(0)="E",DIQ="ECXDIQ" D EN^DIQ1
W !!,ECXDIQ(727,EC,6,"E")_" Extract (#"_EC_")",?42,"Records: ",ECXDIQ(727,EC,5,"E")
W !,"Generated: ",ECXDIQ(727,EC,1,"E"),?42,"Start date: ",ECXDIQ(727,EC,3,"E")
W !,"Division: ",$E(ECXDIQ(727,EC,15,"E"),1,26),?42,"End date: ",ECXDIQ(727,EC,4,"E")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXXREV 2007 printed Apr 09, 2024@20:57:10 Page 2
ECXXREV ;ALB/JAP,BIR/DMA-Status Report from the Extract Log ; [ 05/29/96 5:38 PM ]
+1 ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
EN ;entry point from option
+1 NEW EC,EC0,ECM,ECXDIQ,X,Y,DIC,DIQ,DR,POP
+2 SET DIC=727
SET DIC(0)="AEQMZ"
DO ^DIC
KILL DIC
+3 if Y<0
QUIT
+4 SET EC=+Y
SET EC0=Y(0)
+5 DO SHOW
+6 KILL IO("Q")
SET %ZIS="Q"
DO ^%ZIS
KILL %ZIS
+7 if POP
QUIT
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTSAVE("EC")=""
SET ZTSAVE("EC0")=""
SET ZTDESC="DSS Extract Status Report"
SET ZTRTN="START^ECXXREV"
+10 DO ^%ZTLOAD
End DoDot:1
QUIT
+11 DO START
WRITE !!
+12 GOTO EN
+13 QUIT
+14 ;
START ;queued entry
+1 NEW ECXDIQ,ECXRUN,C,L,LN,PG,QFLG
+2 USE IO
+3 SET $PIECE(LN,"-",80)=""
SET PG=0
SET QFLG=0
+4 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET ECXRUN=Y
+5 DO HDR
+6 DO SHOW
+7 WRITE !,"Purged: ",$SELECT(ECXDIQ(727,EC,9,"E")]"":ECXDIQ(727,EC,9,"E"),1:"(Not purged)")
+8 WRITE !,"Transmitted: ",$SELECT(ECXDIQ(727,EC,300,"E")]"":ECXDIQ(727,EC,300,"E"),1:"(Not transmitted)")
+9 IF ECXDIQ(727,EC,300,"E")]""
Begin DoDot:1
+10 IF '$ORDER(^ECX(727,EC,1,0))
WRITE !,"All transmission messages confirmed."
QUIT
+11 WRITE !,"Unconfirmed transmission message numbers --"
+12 FOR ECM=0:0
SET ECM=$ORDER(^ECX(727,EC,1,ECM))
if 'ECM
QUIT
Begin DoDot:2
+13 WRITE !,ECM
+14 SET ECM=$ORDER(^ECX(727,EC,1,ECM))
IF 'ECM
SET QFLG=1
QUIT
+15 WRITE ?20,ECM
+16 SET ECM=$ORDER(^ECX(727,EC,1,ECM))
IF 'ECM
SET QFLG=1
QUIT
+17 WRITE ?40,ECM
+18 IF $Y+3>IOSL
DO HDR
if QFLG
QUIT
End DoDot:2
if QFLG
QUIT
End DoDot:1
+19 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL IO("Q")
+20 QUIT
+21 ;
HDR ;header
+1 NEW JJ,SS
+2 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+3 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+4 IF PG>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
if 'Y
SET QFLG=1
End DoDot:1
+5 if QFLG
QUIT
+6 if $Y
WRITE @IOF
SET PG=PG+1
+7 WRITE !,"Status Report for DSS Extract #",EC," ("_$PIECE(EC0,U,3)_")"
+8 IF $EXTRACT(IOST)'="C"
WRITE !,"Printed: ",ECXRUN,?68,"Page: ",PG
+9 WRITE !,LN
+10 IF PG>1
WRITE !,"Unconfirmed transmission message numbers (con.t) --",!
+11 QUIT
+12 ;
SHOW ;get data on extract
+1 SET DIC="^ECX(727,"
SET DR="1;6;3;4;5;9;15;300"
SET DA=+EC
SET DIQ(0)="E"
SET DIQ="ECXDIQ"
DO EN^DIQ1
+2 WRITE !!,ECXDIQ(727,EC,6,"E")_" Extract (#"_EC_")",?42,"Records: ",ECXDIQ(727,EC,5,"E")
+3 WRITE !,"Generated: ",ECXDIQ(727,EC,1,"E"),?42,"Start date: ",ECXDIQ(727,EC,3,"E")
+4 WRITE !,"Division: ",$EXTRACT(ECXDIQ(727,EC,15,"E"),1,26),?42,"End date: ",ECXDIQ(727,EC,4,"E")
+5 QUIT
