- ECXLOG ;ALB/GTS - Extract Log Report for DSS ;8/6/24 12:28
- ;;3.0;DSS EXTRACTS;**84,95,92,149,190**;Dec 22, 1997;Build 36
- ;
- EN ;entry point from option
- ;Initialize variables
- N DIR,ECSD1,ECED,X,Y,ECXPORT,CNT ;149
- ;Prompt for start date
- S DIR(0)="D^::EX"
- S DIR("A")="Enter Report Start Date"
- D ^DIR
- I $D(DIRUT) Q
- S ECSD1=Y
- ;Prompt for end date
- K DIR,X,Y
- S DIR(0)="D^"_ECSD1_":"_DT_":EX"
- S DIR("A")="Enter Report Ending Date"
- D ^DIR
- I $D(DIRUT) Q
- S ECED=Y
- S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q ;149 Section added
- .K ^TMP($J,"ECXPORT")
- .S ^TMP($J,"ECXPORT",0)="EXTRACT NUMBER^VISTA PACKAGE^DATA SET DATES^RECORD COUNT^DATE TRANSMITTED^DATE PURGED^DATE EXTRACTED^DATA MONTH^MSG UNCONF^REQUESTOR",CNT=1
- .D EN1
- .D EXPDISP^ECXUTL1
- .K ^TMP($J)
- ;Queue Report
- W !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **",!!
- N ZTDESC,ZTIO,ZTSAVE,I
- S ZTIO=""
- S ZTDESC="DSS EXTRACT LOG STATISTICS"
- F I="ECSD1","ECED","ECXNUM","ECXPKG","ECXSET","ECXTXDT","ECXPURGE","ECXTRACT","ECXMONTH","ECXUCONF" D
- .S ZTSAVE(I)=""
- D EN^XUTMDEVQ("EN1^ECXLOG",ZTDESC,.ZTSAVE)
- Q
- ;
- EN1 ;Tasked entry point
- ;Input : ECSD1 - FM format report start date
- ; ECED - FM format report end date
- ;
- ;Output : None
- ;
- ;Declare variables
- N LN,PAGENUM,STOP,ECXCT,ECXDACT,ECXNUM,ECXPKG,ECXSET,ECXCOUNT,ECXTXDT
- N ECXPURGE,ECXTRACT,ECXUMSG,ECXUSER,ECXMONTH,MSGNUM,COUNT,DIC,ECX0,X
- N ECX1,ECXED1,QFLG
- S ECXED1=ECED+.9999,ECXCT=ECSD1-.0001,(QFLG,PAGENUM,STOP)=0
- I '$G(ECXPORT) D HEADER I STOP D EXIT Q ;149
- D GETDATA
- I '$G(ECXPORT) I $O(^TMP("ECXDSS",$J,""))="" D Q ;149
- .W !
- .W !,"***********************************************"
- .W !,"* NOTHING TO REPORT FOR SELECTED TIME FRAME *"
- .W !,"***********************************************"
- .D WAIT
- D DETAIL I STOP D EXIT Q
- K ^TMP("ECXDSS",$J)
- Q
- ;
- GETDATA ;Get data
- F S ECXCT=$O(^ECX(727,"AE",ECXCT)) Q:(ECXCT>ECXED1)!('ECXCT)!(QFLG=1) D
- .S ECXDACT=0
- .F S ECXDACT=$O(^ECX(727,"AE",ECXCT,ECXDACT)) Q:('ECXDACT)!(QFLG=1) D
- ..;Get data nodes
- ..S ECX0=$G(^ECX(727,ECXDACT,0)),ECX1=$G(^(1))
- ..Q:ECX0=""
- ..S ECXNUM=$P(ECX0,U,1),ECXPKG=$E($P(ECX0,U,3),1,13),ECXSET=$E($P(ECX0,U,4),2,7)_"-"_$E($P(ECX0,U,5),2,7),ECXCOUNT=$P(ECX0,U,6),ECXTXDT=$G(^ECX(727,ECXDACT,"TR")),ECXPURGE=$G(^ECX(727,ECXDACT,"PURG")),ECXTRACT=$P(ECX0,U,2),ECXUSER=$P(ECX0,U,7)
- ..S ECXMONTH=$P($$FMTE^XLFDT($P(ECX0,U,5),"D")," ",1)_" "_$P($$FMTE^XLFDT($P(ECX0,U,5),"D")," ",3)
- ..;Resolve external values for ECXUSER
- ..K DIC S DIC="^VA(200,",DIC(0)="NZ",X=ECXUSER D ^DIC
- ..S ECXUSER=$P($G(Y(0)),U,1)
- ..;Count number of UNCONF messages in Message number multiple
- ..S (MSGNUM,COUNT)=0 F S MSGNUM=$O(^ECX(727,ECXDACT,1,MSGNUM)) Q:MSGNUM'>0 D
- ...S COUNT=COUNT+1
- ..S ECXUMSG=$G(COUNT)
- ..;Save for later
- ..S ^TMP("ECXDSS",$J,ECXPKG,ECXNUM)=ECXNUM_U_ECXPKG_U_ECXSET_U_ECXCOUNT_U_ECXTXDT_U_ECXPURGE_U_ECXTRACT_U_ECXMONTH_U_ECXUMSG_U_ECXUSER
- ..Q
- .Q
- Q
- ;
- S PAGENUM=$G(PAGENUM)+1
- S $P(LN,"-",132)=""
- W @IOF
- W !,?1,"DSS EXTRACT LOG STATISTICS",?120,"Page: ",PAGENUM
- W !!,?1,"EXTRACT NUMBER",?20,"VISTA PACKAGE",?39,"DATA SET DATES",?59,"RECORD COUNT",?75,"DATE TRANSMITTED",?98,"DATE PURGED"
- W !,?3,"DATE EXTRACTED",?25,"DATA MONTH",?40,"MSG UNCONF"
- W ?60,"REQUESTOR"
- W !?1,LN
- Q
- ;
- DETAIL ;Print detailed line
- ;Input : ^TMP("ECXDSS",$J) full global reference
- ; ECXNUM - Extract Number
- ; ECXPKG - VistA Package
- ; ECXDATA - Data Set
- ; ECXCOUNT - Record Count
- ; ECXTXDT - Transmission Date
- ; ECXPURGE - Extract Purge Date
- ; ECXTRACT - Extract Date
- ; ECXMONTH - Data Month and Year
- ; ECXUCONF - Unconfirmed Messages
- ; ECXUSER - Requestor
- ;Output : None
- ;
- N NODE,PACKAGE,NUMBER,P ;149
- S PACKAGE="" F S PACKAGE=$O(^TMP("ECXDSS",$J,PACKAGE)) Q:PACKAGE=""!(STOP) D Q:STOP
- .S NUMBER=0 F S NUMBER=$O(^TMP("ECXDSS",$J,PACKAGE,NUMBER)) Q:'NUMBER!(STOP) D Q:STOP
- ..S NODE=^TMP("ECXDSS",$J,PACKAGE,NUMBER)
- ..I $G(ECXPORT) D Q ;149 Section added
- ...F P=1:1:10 S ^TMP($J,"ECXPORT",CNT)=$G(^TMP($J,"ECXPORT",CNT))_$S(P=1:"",1:U)_$S(P'>4!(P'<8&(P'>10)):$P(NODE,U,P),1:$$FMTE^XLFDT($P(NODE,U,P),"D"))
- ...S CNT=CNT+1
- ..W !!,?1,$P(NODE,U,1),?20,$P(NODE,U,2),?39,$P(NODE,U,3),?59,$P(NODE,U,4),?75,$$FMTE^XLFDT($P(NODE,U,5),"D"),?98,$$FMTE^XLFDT($P(NODE,U,6),"D")
- ..W !,?3,$$FMTE^XLFDT($P(NODE,U,7),"D"),?25,$P(NODE,U,8),?40,$P(NODE,U,9),?60,$P(NODE,U,10)
- ..I $Y>(IOSL-5) D WAIT Q:STOP D HEADER
- ..Q
- Q
- ;
- WAIT ;End of page logic
- ;Input ; None
- ;Output ; STOP - Flag indicating if printing should continue
- ; 1 = Stop 0 = Continue
- ;
- S STOP=0
- ;CRT - Prompt for continue
- I $E(IOST,1,2)="C-"&(IOSL'>24) D Q
- .F Q:$Y>(IOSL-3) W !
- .N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- .S DIR(0)="E"
- .D ^DIR
- .S STOP=$S(Y'=1:1,1:0)
- ;Background task - check taskman
- S STOP=$$S^%ZTLOAD()
- I STOP D
- .W !,"*********************************************"
- .W !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
- .W !,"*********************************************"
- Q
- EXIT ;Kill temp global
- K ^TMP("ECXDSS",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXLOG 5296 printed Jan 18, 2025@02:54:12 Page 2
- ECXLOG ;ALB/GTS - Extract Log Report for DSS ;8/6/24 12:28
- +1 ;;3.0;DSS EXTRACTS;**84,95,92,149,190**;Dec 22, 1997;Build 36
- +2 ;
- EN ;entry point from option
- +1 ;Initialize variables
- +2 ;149
- NEW DIR,ECSD1,ECED,X,Y,ECXPORT,CNT
- +3 ;Prompt for start date
- +4 SET DIR(0)="D^::EX"
- +5 SET DIR("A")="Enter Report Start Date"
- +6 DO ^DIR
- +7 IF $DATA(DIRUT)
- QUIT
- +8 SET ECSD1=Y
- +9 ;Prompt for end date
- +10 KILL DIR,X,Y
- +11 SET DIR(0)="D^"_ECSD1_":"_DT_":EX"
- +12 SET DIR("A")="Enter Report Ending Date"
- +13 DO ^DIR
- +14 IF $DATA(DIRUT)
- QUIT
- +15 SET ECED=Y
- +16 ;149 Section added
- SET ECXPORT=$$EXPORT^ECXUTL1
- if ECXPORT=-1
- QUIT
- IF $GET(ECXPORT)
- Begin DoDot:1
- +17 KILL ^TMP($JOB,"ECXPORT")
- +18 SET ^TMP($JOB,"ECXPORT",0)="EXTRACT NUMBER^VISTA PACKAGE^DATA SET DATES^RECORD COUNT^DATE TRANSMITTED^DATE PURGED^DATE EXTRACTED^DATA MONTH^MSG UNCONF^REQUESTOR"
- SET CNT=1
- +19 DO EN1
- +20 DO EXPDISP^ECXUTL1
- +21 KILL ^TMP($JOB)
- End DoDot:1
- QUIT
- +22 ;Queue Report
- +23 WRITE !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **",!!
- +24 NEW ZTDESC,ZTIO,ZTSAVE,I
- +25 SET ZTIO=""
- +26 SET ZTDESC="DSS EXTRACT LOG STATISTICS"
- +27 FOR I="ECSD1","ECED","ECXNUM","ECXPKG","ECXSET","ECXTXDT","ECXPURGE","ECXTRACT","ECXMONTH","ECXUCONF"
- Begin DoDot:1
- +28 SET ZTSAVE(I)=""
- End DoDot:1
- +29 DO EN^XUTMDEVQ("EN1^ECXLOG",ZTDESC,.ZTSAVE)
- +30 QUIT
- +31 ;
- EN1 ;Tasked entry point
- +1 ;Input : ECSD1 - FM format report start date
- +2 ; ECED - FM format report end date
- +3 ;
- +4 ;Output : None
- +5 ;
- +6 ;Declare variables
- +7 NEW LN,PAGENUM,STOP,ECXCT,ECXDACT,ECXNUM,ECXPKG,ECXSET,ECXCOUNT,ECXTXDT
- +8 NEW ECXPURGE,ECXTRACT,ECXUMSG,ECXUSER,ECXMONTH,MSGNUM,COUNT,DIC,ECX0,X
- +9 NEW ECX1,ECXED1,QFLG
- +10 SET ECXED1=ECED+.9999
- SET ECXCT=ECSD1-.0001
- SET (QFLG,PAGENUM,STOP)=0
- +11 ;149
- IF '$GET(ECXPORT)
- DO HEADER
- IF STOP
- DO EXIT
- QUIT
- +12 DO GETDATA
- +13 ;149
- IF '$GET(ECXPORT)
- IF $ORDER(^TMP("ECXDSS",$JOB,""))=""
- Begin DoDot:1
- +14 WRITE !
- +15 WRITE !,"***********************************************"
- +16 WRITE !,"* NOTHING TO REPORT FOR SELECTED TIME FRAME *"
- +17 WRITE !,"***********************************************"
- +18 DO WAIT
- End DoDot:1
- QUIT
- +19 DO DETAIL
- IF STOP
- DO EXIT
- QUIT
- +20 KILL ^TMP("ECXDSS",$JOB)
- +21 QUIT
- +22 ;
- GETDATA ;Get data
- +1 FOR
- SET ECXCT=$ORDER(^ECX(727,"AE",ECXCT))
- if (ECXCT>ECXED1)!('ECXCT)!(QFLG=1)
- QUIT
- Begin DoDot:1
- +2 SET ECXDACT=0
- +3 FOR
- SET ECXDACT=$ORDER(^ECX(727,"AE",ECXCT,ECXDACT))
- if ('ECXDACT)!(QFLG=1)
- QUIT
- Begin DoDot:2
- +4 ;Get data nodes
- +5 SET ECX0=$GET(^ECX(727,ECXDACT,0))
- SET ECX1=$GET(^(1))
- +6 if ECX0=""
- QUIT
- +7 SET ECXNUM=$PIECE(ECX0,U,1)
- SET ECXPKG=$EXTRACT($PIECE(ECX0,U,3),1,13)
- SET ECXSET=$EXTRACT($PIECE(ECX0,U,4),2,7)_"-"_$EXTRACT($PIECE(ECX0,U,5),2,7)
- SET ECXCOUNT=$PIECE(ECX0,U,6)
- SET ECXTXDT=$GET(^ECX(727,ECXDACT,"TR"))
- SET ECXPURGE=$GET(^ECX(727,ECXDACT,"PURG"))
- SET ECXTRACT=$PIECE(ECX0,U,2)
- SET ECXUSER=$PIECE(ECX0,U,7)
- +8 SET ECXMONTH=$PIECE($$FMTE^XLFDT($PIECE(ECX0,U,5),"D")," ",1)_" "_$PIECE($$FMTE^XLFDT($PIECE(ECX0,U,5),"D")," ",3)
- +9 ;Resolve external values for ECXUSER
- +10 KILL DIC
- SET DIC="^VA(200,"
- SET DIC(0)="NZ"
- SET X=ECXUSER
- DO ^DIC
- +11 SET ECXUSER=$PIECE($GET(Y(0)),U,1)
- +12 ;Count number of UNCONF messages in Message number multiple
- +13 SET (MSGNUM,COUNT)=0
- FOR
- SET MSGNUM=$ORDER(^ECX(727,ECXDACT,1,MSGNUM))
- if MSGNUM'>0
- QUIT
- Begin DoDot:3
- +14 SET COUNT=COUNT+1
- End DoDot:3
- +15 SET ECXUMSG=$GET(COUNT)
- +16 ;Save for later
- +17 SET ^TMP("ECXDSS",$JOB,ECXPKG,ECXNUM)=ECXNUM_U_ECXPKG_U_ECXSET_U_ECXCOUNT_U_ECXTXDT_U_ECXPURGE_U_ECXTRACT_U_ECXMONTH_U_ECXUMSG_U_ECXUSER
- +18 QUIT
- End DoDot:2
- +19 QUIT
- End DoDot:1
- +20 QUIT
- +21 ;
- +1 SET PAGENUM=$GET(PAGENUM)+1
- +2 SET $PIECE(LN,"-",132)=""
- +3 WRITE @IOF
- +4 WRITE !,?1,"DSS EXTRACT LOG STATISTICS",?120,"Page: ",PAGENUM
- +5 WRITE !!,?1,"EXTRACT NUMBER",?20,"VISTA PACKAGE",?39,"DATA SET DATES",?59,"RECORD COUNT",?75,"DATE TRANSMITTED",?98,"DATE PURGED"
- +6 WRITE !,?3,"DATE EXTRACTED",?25,"DATA MONTH",?40,"MSG UNCONF"
- +7 WRITE ?60,"REQUESTOR"
- +8 WRITE !?1,LN
- +9 QUIT
- +10 ;
- DETAIL ;Print detailed line
- +1 ;Input : ^TMP("ECXDSS",$J) full global reference
- +2 ; ECXNUM - Extract Number
- +3 ; ECXPKG - VistA Package
- +4 ; ECXDATA - Data Set
- +5 ; ECXCOUNT - Record Count
- +6 ; ECXTXDT - Transmission Date
- +7 ; ECXPURGE - Extract Purge Date
- +8 ; ECXTRACT - Extract Date
- +9 ; ECXMONTH - Data Month and Year
- +10 ; ECXUCONF - Unconfirmed Messages
- +11 ; ECXUSER - Requestor
- +12 ;Output : None
- +13 ;
- +14 ;149
- NEW NODE,PACKAGE,NUMBER,P
- +15 SET PACKAGE=""
- FOR
- SET PACKAGE=$ORDER(^TMP("ECXDSS",$JOB,PACKAGE))
- if PACKAGE=""!(STOP)
- QUIT
- Begin DoDot:1
- +16 SET NUMBER=0
- FOR
- SET NUMBER=$ORDER(^TMP("ECXDSS",$JOB,PACKAGE,NUMBER))
- if 'NUMBER!(STOP)
- QUIT
- Begin DoDot:2
- +17 SET NODE=^TMP("ECXDSS",$JOB,PACKAGE,NUMBER)
- +18 ;149 Section added
- IF $GET(ECXPORT)
- Begin DoDot:3
- +19 FOR P=1:1:10
- SET ^TMP($JOB,"ECXPORT",CNT)=$GET(^TMP($JOB,"ECXPORT",CNT))_$SELECT(P=1:"",1:U)_$SELECT(P'>4!(P'<8&(P'>10)):$PIECE(NODE,U,P),1:$$FMTE^XLFDT($PIECE(NODE,U,P),"D"))
- +20 SET CNT=CNT+1
- End DoDot:3
- QUIT
- +21 WRITE !!,?1,$PIECE(NODE,U,1),?20,$PIECE(NODE,U,2),?39,$PIECE(NODE,U,3),?59,$PIECE(NODE,U,4),?75,$$FMTE^XLFDT($PIECE(NODE,U,5),"D"),?98,$$FMTE^XLFDT($PIECE(NODE,U,6),"D")
- +22 WRITE !,?3,$$FMTE^XLFDT($PIECE(NODE,U,7),"D"),?25,$PIECE(NODE,U,8),?40,$PIECE(NODE,U,9),?60,$PIECE(NODE,U,10)
- +23 IF $Y>(IOSL-5)
- DO WAIT
- if STOP
- QUIT
- DO HEADER
- +24 QUIT
- End DoDot:2
- if STOP
- QUIT
- End DoDot:1
- if STOP
- QUIT
- +25 QUIT
- +26 ;
- WAIT ;End of page logic
- +1 ;Input ; None
- +2 ;Output ; STOP - Flag indicating if printing should continue
- +3 ; 1 = Stop 0 = Continue
- +4 ;
- +5 SET STOP=0
- +6 ;CRT - Prompt for continue
- +7 IF $EXTRACT(IOST,1,2)="C-"&(IOSL'>24)
- Begin DoDot:1
- +8 FOR
- if $Y>(IOSL-3)
- QUIT
- WRITE !
- +9 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +10 SET DIR(0)="E"
- +11 DO ^DIR
- +12 SET STOP=$SELECT(Y'=1:1,1:0)
- End DoDot:1
- QUIT
- +13 ;Background task - check taskman
- +14 SET STOP=$$S^%ZTLOAD()
- +15 IF STOP
- Begin DoDot:1
- +16 WRITE !,"*********************************************"
- +17 WRITE !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
- +18 WRITE !,"*********************************************"
- End DoDot:1
- +19 QUIT
- EXIT ;Kill temp global
- +1 KILL ^TMP("ECXDSS",$JOB)
- +2 QUIT