- 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 Feb 18, 2025@23:20:55 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
