ECXUEC ;ALB/TJL,JAP - Event Capture Pre-Extract Unusual Volume Report ;6/1/17 15:33
;;3.0;DSS EXTRACTS;**120,127,148,149,161,166**;Dec 22, 1997;Build 24
;
EN ; entry point
N X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD
N ECSD,ECSD1,ECSTART,ECXDSS,ECED,ECEND,ECXERR,QFLG,DIR,DTOUT,DUOUT,DIRUT,POP,ZTSK,ZTQUEUED,DIC,%,ECXPORT,CNT ;149
S QFLG=0,ECTHLD=""
; get today's date
D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
D BEGIN Q:QFLG
D SELECT Q:QFLG
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q ;149 Section added
.K ^TMP($J,"ECXPORT")
.S ^TMP($J,"ECXPORT",0)="SSN^FACILITY^DSS UNIT^DATE/TIME^PROCEDURE^VOLUME^PROVIDER",CNT=1
.D START,PRINT
.D EXPDISP^ECXUTL1
.K ^TMP($J,"ECXPORT"),^TMP("ECUV",$J)
S ECXDESC="Event Capture Pre-Extract Unusual Volume Report" ;tjl 166 Changed report title
S ECXSAVE("EC*")=""
W !!,"This report is formatted for 132-column line width."
W !!,"Enter 'Q' to queue report to TaskManager, then select printer."
D EN^XUTMDEVQ("PROCESS^ECXUEC",ECXDESC,.ECXSAVE,"",1)
I $G(POP) W !!,"No device selected...exiting.",! Q
I IO'=IO(0) D ^%ZISC
D HOME^%ZIS
I $D(ZTSK) W !!,"Queued as Task #"_ZTSK_"."
Q
;
BEGIN ; display report description
W @IOF
W !,"Event Capture Pre-Extract Unusual Volume Report" ;tjl 166 Changed report title
W !!," This report prints a listing of unusual volumes that would be"
W !," generated by the Event Capture extract (ECS) as determined by"
W !," a user-defined threshold value. It should be run prior to"
W !," the generation of an actual extract to identify and fix, as"
W !," necessary, any volumes determined to be erroneous."
W !!," Unusual volumes are those in excess of the threshold value"
W !," defined by the user. The threshold value is 20 by default."
W !!," Note: You may set a different threshold if you opt to continue."
W !!," Run times will vary depending upon the size of the EVENT CAPTURE"
W !," PATIENT file (#721) and the date range selected, but may be at"
W !," least several minutes. Queuing to a printer is recommended."
W !!," The running of this report has no effect on the actual extracts"
W !," and can be run as needed."
W !!," You may select one or all DSS Units. If you select one unit,"
W !," the report is sorted by descending volume. If you select all DSS Units, "
W !," the report is sorted by DSS Unit, then by descending volume."
S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
W:$Y!($E(IOST)="C") @IOF,!!
Q
;
SELECT ; user inputs for threshold volume and date range
N DONE,OUT
; allow user to set threshold volume
S ECTHLD=20
W !!,"The default threshold volume for unusual volumes in Event Capture is "_ECTHLD_"."
S DIR(0)="Y",DIR("A")="Would you like to change the threshold",DIR("B")="NO"
D ^DIR K DIR I X["^" S QFLG=1 Q
I Y D
.W !!,"Volume > threshold"
.S DIR(0)="N^0:99",DIR("A")="Enter the new threshold volume"
.D ^DIR K DIR S ECTHLD=Y I X["^" S QFLG=1
; get DSS Unit selection from user
Q:QFLG
W !
S DIR(0)="Y",DIR("A")="Do you want All DSS Units",DIR("B")="YES"
D ^DIR K DIR I X["^" S QFLG=1 Q
I Y S ECXDSS="ALL"
E D I QFLG=1 Q
.S DIC(0)="AEQM",DIC="^ECD(" D ^DIC K DIC I X["^" S QFLG=1 Q
.I Y=-1 S QFLG=1 Q
.S ECXDSS=+$G(Y) I ECXDSS=0 S QFLG=1 Q
; get date range from user
W !!,"Enter the date range for which you would like to scan the"
W !,"Event Capture records.",!
S DONE=0 F S (ECED,ECSD)="" D Q:QFLG!DONE
.K %DT S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)=-DATE D ^%DT
.I Y<0 S QFLG=1 Q
.S ECSD=Y,ECSD1=ECSD-.1
.D DD^%DT S ECSTART=Y
.K %DT S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)=-DATE D ^%DT
.I Y<0 S QFLG=1 Q
.I Y<ECSD D Q
..W !!,"The ending date cannot be earlier than the starting date."
..W !,"Please try again.",!!
.I $E(Y,1,5)'=$E(ECSD,1,5) D Q
..W !!,"Beginning and ending dates must be in the same month and year"
..W !,"Please try again.",!!
.S ECED=Y
.D DD^%DT S ECEND=Y
.S DONE=1
Q
;
PROCESS ; entry point for queued report
N QFLG
S ZTREQ="@"
S ECXERR=0 D START Q:ECXERR
S QFLG=0 D PRINT
K ^TMP("ECUV",$J) D ^ECXKILL
Q
;
START ;find EC records in date range
I ECXDSS="ALL" D
.N X,Y,ECLL,ECDA,ECD,COUNT
.S ECED=ECED+.3,ECLL=0,COUNT=0
.K ^TMP("ECUV",$J)
.F S ECLL=$O(^ECH("AC1",ECLL)),ECD=ECSD-.1 Q:'ECLL D
..F S ECD=$O(^ECH("AC1",ECLL,ECD)),ECDA=0 Q:(ECD>ECED)!('ECD) D
...F S ECDA=$O(^ECH("AC1",ECLL,ECD,ECDA)) Q:'ECDA D GETREC
E D
.N X,Y,ECLL,ECPAT,ECDA,ECD,COUNT
.S ECED=ECED+.3,ECLL=0,ECPAT=0,COUNT=0
.K ^TMP("ECUV",$J)
.F S ECLL=$O(^ECH("ADT",ECLL)) Q:'ECLL D
.. S ECPAT=0
.. F S ECPAT=$O(^ECH("ADT",ECLL,ECPAT)),ECD=ECSD-.1 Q:'ECPAT D
...F S ECD=$O(^ECH("ADT",ECLL,ECPAT,ECXDSS,ECD)),ECDA=0 Q:(ECD>ECED)!('ECD) D
....F S ECDA=$O(^ECH("ADT",ECLL,ECPAT,ECXDSS,ECD,ECDA)) Q:'ECDA D GETREC
Q
;
GETREC ;get data for report
N ECCH,ECL,ECXDFN,ECXSSN,ECXPDIV,ECDT,ECDU,ECV,ECP,ECXPROV,ECXPRV,ECXDATE,ECXUNIT
N ECXDOB,ECXETH,ECXMAR,ECXMPI,ECXPNM,ECXPRIME,ECXRACE,ECXRC1,ECXREL,ECXSEX,N1,N2,VA,ECHEAD,ECPNM ;161
S ECCH=^ECH(ECDA,0),ECV=$P(ECCH,U,10)
Q:(ECV<ECTHLD)
S ECL=$P(ECCH,U,4),ECXDFN=$P(ECCH,U,2)
S ECXPDIV=$$RADDIV^ECXDEPT(ECL) ;Get production division from file 4
S ECDT=$P(ECCH,U,3),ECDU=$P(ECCH,U,7),ECP=$P(ECCH,U,9)
Q:(ECP']"")
I ECP[";" S ECHEAD="ECS",ECPNM=$S(ECP["ICPT":$P(^ICPT(+ECP,0),U),ECP<90000:$P(^EC(725,+ECP,0),U,2),1:$P(^EC(725,+ECP,0),U,2)) ;161 Setting ECHEAD and ECPNM to allow potential test patients with certain procedures to be included
Q:('$$PATDEM^ECXUTL2(ECXDFN,ECDT,"1;","12"))
S ECXDATE=$$FMTE^XLFDT(ECDT,5)
K ECXPRV S X=$$GETPPRV^ECPRVMUT(ECDA,.ECXPRV),ECXPROV=$E($P(ECXPRV,U,2),1,30)
I ECXPROV]"" D
.S N1=$$TITLE^XLFSTR($P(ECXPROV,",")),N2=$$TITLE^XLFSTR($P(ECXPROV,",",2))
.S ECXPROV=(N1_","_N2)
I ECP[";" D
.S ECP=$S(ECP["ICPT":$P(^ICPT(+ECP,0),U)_"01",ECP<90000:$P(^EC(725,+ECP,0),U,2)_"N",1:$P(^EC(725,+ECP,0),U,2)_"L")
S ECXUNIT=$P($G(^ECD(ECDU,0)),U)
S COUNT=COUNT+1
S ^TMP("ECUV",$J,ECXUNIT,(100-ECV),COUNT)=ECXSSN_U_ECXPDIV_U_ECXDATE_U_ECP_U_ECXPROV_U_ECV
Q
;
PRINT ; process temp file and print report
N PG,QFLG,LN,COUNT,REC,CC,SS,JJ,ZTSTOP
N ECXUNIT,ECV,ECVV,ECXSSN,ECXPDIV,ECXDATE,ECXUNIT,ECP,ECXPROV
U IO
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
S (PG,QFLG,COUNT)=0,$P(LN,"-",130)=""
I '$G(ECXPORT) D HEADER Q:QFLG ;149
S ECXUNIT="" F S ECXUNIT=$O(^TMP("ECUV",$J,ECXUNIT)) Q:ECXUNIT="" D Q:QFLG
.I '$G(ECXPORT) I COUNT>0 W !,?1,LN ;149
.S ECVV=0 F S ECVV=$O(^TMP("ECUV",$J,ECXUNIT,ECVV)) Q:'ECVV D Q:QFLG
..S CC=0 F S CC=$O(^TMP("ECUV",$J,ECXUNIT,ECVV,CC)) Q:'CC D Q:QFLG
...S REC=^TMP("ECUV",$J,ECXUNIT,ECVV,CC),COUNT=COUNT+1
...S ECXSSN=$P(REC,U),ECXPDIV=$P(REC,U,2),ECXDATE=$P(REC,U,3),ECP=$P(REC,U,4),ECXPROV=$P(REC,U,5),ECV=$P(REC,U,6)
...I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=ECXSSN_U_ECXPDIV_U_ECXUNIT_U_ECXDATE_U_ECP_U_ECV_U_ECXPROV,CNT=CNT+1 Q ;149
...W !,?1,ECXSSN,?13,ECXPDIV,?24,ECXUNIT,?55,ECXDATE,?75,ECP,?86,ECV,?94,ECXPROV
...I $Y+4>IOSL D HEADER Q:QFLG
I $G(ECXPORT) Q ;149 Nothing more to print if exporting
Q:QFLG
I COUNT=0 W !!,?8,"No unusual Event Capture volumes to report for the date range.",!!
D SS
Q
;
D:PG SS Q:QFLG
Q:QFLG
W:$Y!($E(IOST)="C") @IOF S PG=PG+1
W !,ECXDESC,?103,"Page: "_PG
W !,"Start Date: ",ECSTART,?92,"Report Run Date: "_ECRUN
W !," End Date: ",ECEND,?92,"Threshold Value: ",ECTHLD
W !!,?1,"SSN",?13,"FACILITY",?24,"DSS UNIT",?55,"DATE/TIME",?75,"PROCEDURE",?86,"VOLUME",?94,"PROVIDER"
W !,LN,!
Q
;
SS ;SCROLL STOPS
N JJ,SS
I $E(IOST)="C" S SS=21-$Y F JJ=1:1:SS W !
I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXUEC 7846 printed Dec 13, 2024@01:54:17 Page 2
ECXUEC ;ALB/TJL,JAP - Event Capture Pre-Extract Unusual Volume Report ;6/1/17 15:33
+1 ;;3.0;DSS EXTRACTS;**120,127,148,149,161,166**;Dec 22, 1997;Build 24
+2 ;
EN ; entry point
+1 NEW X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD
+2 ;149
NEW ECSD,ECSD1,ECSTART,ECXDSS,ECED,ECEND,ECXERR,QFLG,DIR,DTOUT,DUOUT,DIRUT,POP,ZTSK,ZTQUEUED,DIC,%,ECXPORT,CNT
+3 SET QFLG=0
SET ECTHLD=""
+4 ; get today's date
+5 DO NOW^%DTC
SET DATE=X
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET ECRUN=$PIECE(Y,"@")
KILL %DT
+6 DO BEGIN
if QFLG
QUIT
+7 DO SELECT
if QFLG
QUIT
+8 ;149 Section added
SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
IF $GET(ECXPORT)
Begin DoDot:1
+9 KILL ^TMP($JOB,"ECXPORT")
+10 SET ^TMP($JOB,"ECXPORT",0)="SSN^FACILITY^DSS UNIT^DATE/TIME^PROCEDURE^VOLUME^PROVIDER"
SET CNT=1
+11 DO START
DO PRINT
+12 DO EXPDISP^ECXUTL1
+13 KILL ^TMP($JOB,"ECXPORT"),^TMP("ECUV",$JOB)
End DoDot:1
QUIT
+14 ;tjl 166 Changed report title
SET ECXDESC="Event Capture Pre-Extract Unusual Volume Report"
+15 SET ECXSAVE("EC*")=""
+16 WRITE !!,"This report is formatted for 132-column line width."
+17 WRITE !!,"Enter 'Q' to queue report to TaskManager, then select printer."
+18 DO EN^XUTMDEVQ("PROCESS^ECXUEC",ECXDESC,.ECXSAVE,"",1)
+19 IF $GET(POP)
WRITE !!,"No device selected...exiting.",!
QUIT
+20 IF IO'=IO(0)
DO ^%ZISC
+21 DO HOME^%ZIS
+22 IF $DATA(ZTSK)
WRITE !!,"Queued as Task #"_ZTSK_"."
+23 QUIT
+24 ;
BEGIN ; display report description
+1 WRITE @IOF
+2 ;tjl 166 Changed report title
WRITE !,"Event Capture Pre-Extract Unusual Volume Report"
+3 WRITE !!," This report prints a listing of unusual volumes that would be"
+4 WRITE !," generated by the Event Capture extract (ECS) as determined by"
+5 WRITE !," a user-defined threshold value. It should be run prior to"
+6 WRITE !," the generation of an actual extract to identify and fix, as"
+7 WRITE !," necessary, any volumes determined to be erroneous."
+8 WRITE !!," Unusual volumes are those in excess of the threshold value"
+9 WRITE !," defined by the user. The threshold value is 20 by default."
+10 WRITE !!," Note: You may set a different threshold if you opt to continue."
+11 WRITE !!," Run times will vary depending upon the size of the EVENT CAPTURE"
+12 WRITE !," PATIENT file (#721) and the date range selected, but may be at"
+13 WRITE !," least several minutes. Queuing to a printer is recommended."
+14 WRITE !!," The running of this report has no effect on the actual extracts"
+15 WRITE !," and can be run as needed."
+16 WRITE !!," You may select one or all DSS Units. If you select one unit,"
+17 WRITE !," the report is sorted by descending volume. If you select all DSS Units, "
+18 WRITE !," the report is sorted by DSS Unit, then by descending volume."
+19 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+20 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF,!!
+21 QUIT
+22 ;
SELECT ; user inputs for threshold volume and date range
+1 NEW DONE,OUT
+2 ; allow user to set threshold volume
+3 SET ECTHLD=20
+4 WRITE !!,"The default threshold volume for unusual volumes in Event Capture is "_ECTHLD_"."
+5 SET DIR(0)="Y"
SET DIR("A")="Would you like to change the threshold"
SET DIR("B")="NO"
+6 DO ^DIR
KILL DIR
IF X["^"
SET QFLG=1
QUIT
+7 IF Y
Begin DoDot:1
+8 WRITE !!,"Volume > threshold"
+9 SET DIR(0)="N^0:99"
SET DIR("A")="Enter the new threshold volume"
+10 DO ^DIR
KILL DIR
SET ECTHLD=Y
IF X["^"
SET QFLG=1
End DoDot:1
+11 ; get DSS Unit selection from user
+12 if QFLG
QUIT
+13 WRITE !
+14 SET DIR(0)="Y"
SET DIR("A")="Do you want All DSS Units"
SET DIR("B")="YES"
+15 DO ^DIR
KILL DIR
IF X["^"
SET QFLG=1
QUIT
+16 IF Y
SET ECXDSS="ALL"
+17 IF '$TEST
Begin DoDot:1
+18 SET DIC(0)="AEQM"
SET DIC="^ECD("
DO ^DIC
KILL DIC
IF X["^"
SET QFLG=1
QUIT
+19 IF Y=-1
SET QFLG=1
QUIT
+20 SET ECXDSS=+$GET(Y)
IF ECXDSS=0
SET QFLG=1
QUIT
End DoDot:1
IF QFLG=1
QUIT
+21 ; get date range from user
+22 WRITE !!,"Enter the date range for which you would like to scan the"
+23 WRITE !,"Event Capture records.",!
+24 SET DONE=0
FOR
SET (ECED,ECSD)=""
Begin DoDot:1
+25 KILL %DT
SET %DT="AEX"
SET %DT("A")="Starting with Date: "
SET %DT(0)=-DATE
DO ^%DT
+26 IF Y<0
SET QFLG=1
QUIT
+27 SET ECSD=Y
SET ECSD1=ECSD-.1
+28 DO DD^%DT
SET ECSTART=Y
+29 KILL %DT
SET %DT="AEX"
SET %DT("A")="Ending with Date: "
SET %DT(0)=-DATE
DO ^%DT
+30 IF Y<0
SET QFLG=1
QUIT
+31 IF Y<ECSD
Begin DoDot:2
+32 WRITE !!,"The ending date cannot be earlier than the starting date."
+33 WRITE !,"Please try again.",!!
End DoDot:2
QUIT
+34 IF $EXTRACT(Y,1,5)'=$EXTRACT(ECSD,1,5)
Begin DoDot:2
+35 WRITE !!,"Beginning and ending dates must be in the same month and year"
+36 WRITE !,"Please try again.",!!
End DoDot:2
QUIT
+37 SET ECED=Y
+38 DO DD^%DT
SET ECEND=Y
+39 SET DONE=1
End DoDot:1
if QFLG!DONE
QUIT
+40 QUIT
+41 ;
PROCESS ; entry point for queued report
+1 NEW QFLG
+2 SET ZTREQ="@"
+3 SET ECXERR=0
DO START
if ECXERR
QUIT
+4 SET QFLG=0
DO PRINT
+5 KILL ^TMP("ECUV",$JOB)
DO ^ECXKILL
+6 QUIT
+7 ;
START ;find EC records in date range
+1 IF ECXDSS="ALL"
Begin DoDot:1
+2 NEW X,Y,ECLL,ECDA,ECD,COUNT
+3 SET ECED=ECED+.3
SET ECLL=0
SET COUNT=0
+4 KILL ^TMP("ECUV",$JOB)
+5 FOR
SET ECLL=$ORDER(^ECH("AC1",ECLL))
SET ECD=ECSD-.1
if 'ECLL
QUIT
Begin DoDot:2
+6 FOR
SET ECD=$ORDER(^ECH("AC1",ECLL,ECD))
SET ECDA=0
if (ECD>ECED)!('ECD)
QUIT
Begin DoDot:3
+7 FOR
SET ECDA=$ORDER(^ECH("AC1",ECLL,ECD,ECDA))
if 'ECDA
QUIT
DO GETREC
End DoDot:3
End DoDot:2
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 NEW X,Y,ECLL,ECPAT,ECDA,ECD,COUNT
+10 SET ECED=ECED+.3
SET ECLL=0
SET ECPAT=0
SET COUNT=0
+11 KILL ^TMP("ECUV",$JOB)
+12 FOR
SET ECLL=$ORDER(^ECH("ADT",ECLL))
if 'ECLL
QUIT
Begin DoDot:2
+13 SET ECPAT=0
+14 FOR
SET ECPAT=$ORDER(^ECH("ADT",ECLL,ECPAT))
SET ECD=ECSD-.1
if 'ECPAT
QUIT
Begin DoDot:3
+15 FOR
SET ECD=$ORDER(^ECH("ADT",ECLL,ECPAT,ECXDSS,ECD))
SET ECDA=0
if (ECD>ECED)!('ECD)
QUIT
Begin DoDot:4
+16 FOR
SET ECDA=$ORDER(^ECH("ADT",ECLL,ECPAT,ECXDSS,ECD,ECDA))
if 'ECDA
QUIT
DO GETREC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
GETREC ;get data for report
+1 NEW ECCH,ECL,ECXDFN,ECXSSN,ECXPDIV,ECDT,ECDU,ECV,ECP,ECXPROV,ECXPRV,ECXDATE,ECXUNIT
+2 ;161
NEW ECXDOB,ECXETH,ECXMAR,ECXMPI,ECXPNM,ECXPRIME,ECXRACE,ECXRC1,ECXREL,ECXSEX,N1,N2,VA,ECHEAD,ECPNM
+3 SET ECCH=^ECH(ECDA,0)
SET ECV=$PIECE(ECCH,U,10)
+4 if (ECV<ECTHLD)
QUIT
+5 SET ECL=$PIECE(ECCH,U,4)
SET ECXDFN=$PIECE(ECCH,U,2)
+6 ;Get production division from file 4
SET ECXPDIV=$$RADDIV^ECXDEPT(ECL)
+7 SET ECDT=$PIECE(ECCH,U,3)
SET ECDU=$PIECE(ECCH,U,7)
SET ECP=$PIECE(ECCH,U,9)
+8 if (ECP']"")
QUIT
+9 ;161 Setting ECHEAD and ECPNM to allow potential test patients with certain procedures to be included
IF ECP[";"
SET ECHEAD="ECS"
SET ECPNM=$SELECT(ECP["ICPT":$PIECE(^ICPT(+ECP,0),U),ECP<90000:$PIECE(^EC(725,+ECP,0),U,2),1:$PIECE(^EC(725,+ECP,0),U,2))
+10 if ('$$PATDEM^ECXUTL2(ECXDFN,ECDT,"1;","12"))
QUIT
+11 SET ECXDATE=$$FMTE^XLFDT(ECDT,5)
+12 KILL ECXPRV
SET X=$$GETPPRV^ECPRVMUT(ECDA,.ECXPRV)
SET ECXPROV=$EXTRACT($PIECE(ECXPRV,U,2),1,30)
+13 IF ECXPROV]""
Begin DoDot:1
+14 SET N1=$$TITLE^XLFSTR($PIECE(ECXPROV,","))
SET N2=$$TITLE^XLFSTR($PIECE(ECXPROV,",",2))
+15 SET ECXPROV=(N1_","_N2)
End DoDot:1
+16 IF ECP[";"
Begin DoDot:1
+17 SET ECP=$SELECT(ECP["ICPT":$PIECE(^ICPT(+ECP,0),U)_"01",ECP<90000:$PIECE(^EC(725,+ECP,0),U,2)_"N",1:$PIECE(^EC(725,+ECP,0),U,2)_"L")
End DoDot:1
+18 SET ECXUNIT=$PIECE($GET(^ECD(ECDU,0)),U)
+19 SET COUNT=COUNT+1
+20 SET ^TMP("ECUV",$JOB,ECXUNIT,(100-ECV),COUNT)=ECXSSN_U_ECXPDIV_U_ECXDATE_U_ECP_U_ECXPROV_U_ECV
+21 QUIT
+22 ;
PRINT ; process temp file and print report
+1 NEW PG,QFLG,LN,COUNT,REC,CC,SS,JJ,ZTSTOP
+2 NEW ECXUNIT,ECV,ECVV,ECXSSN,ECXPDIV,ECXDATE,ECXUNIT,ECP,ECXPROV
+3 USE IO
+4 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
KILL ZTREQ
QUIT
+5 SET (PG,QFLG,COUNT)=0
SET $PIECE(LN,"-",130)=""
+6 ;149
IF '$GET(ECXPORT)
DO HEADER
if QFLG
QUIT
+7 SET ECXUNIT=""
FOR
SET ECXUNIT=$ORDER(^TMP("ECUV",$JOB,ECXUNIT))
if ECXUNIT=""
QUIT
Begin DoDot:1
+8 ;149
IF '$GET(ECXPORT)
IF COUNT>0
WRITE !,?1,LN
+9 SET ECVV=0
FOR
SET ECVV=$ORDER(^TMP("ECUV",$JOB,ECXUNIT,ECVV))
if 'ECVV
QUIT
Begin DoDot:2
+10 SET CC=0
FOR
SET CC=$ORDER(^TMP("ECUV",$JOB,ECXUNIT,ECVV,CC))
if 'CC
QUIT
Begin DoDot:3
+11 SET REC=^TMP("ECUV",$JOB,ECXUNIT,ECVV,CC)
SET COUNT=COUNT+1
+12 SET ECXSSN=$PIECE(REC,U)
SET ECXPDIV=$PIECE(REC,U,2)
SET ECXDATE=$PIECE(REC,U,3)
SET ECP=$PIECE(REC,U,4)
SET ECXPROV=$PIECE(REC,U,5)
SET ECV=$PIECE(REC,U,6)
+13 ;149
IF $GET(ECXPORT)
SET ^TMP($JOB,"ECXPORT",CNT)=ECXSSN_U_ECXPDIV_U_ECXUNIT_U_ECXDATE_U_ECP_U_ECV_U_ECXPROV
SET CNT=CNT+1
QUIT
+14 WRITE !,?1,ECXSSN,?13,ECXPDIV,?24,ECXUNIT,?55,ECXDATE,?75,ECP,?86,ECV,?94,ECXPROV
+15 IF $Y+4>IOSL
DO HEADER
if QFLG
QUIT
End DoDot:3
if QFLG
QUIT
End DoDot:2
if QFLG
QUIT
End DoDot:1
if QFLG
QUIT
+16 ;149 Nothing more to print if exporting
IF $GET(ECXPORT)
QUIT
+17 if QFLG
QUIT
+18 IF COUNT=0
WRITE !!,?8,"No unusual Event Capture volumes to report for the date range.",!!
+19 DO SS
+20 QUIT
+21 ;
+1 if PG
DO SS
if QFLG
QUIT
+2 if QFLG
QUIT
+3 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
SET PG=PG+1
+4 WRITE !,ECXDESC,?103,"Page: "_PG
+5 WRITE !,"Start Date: ",ECSTART,?92,"Report Run Date: "_ECRUN
+6 WRITE !," End Date: ",ECEND,?92,"Threshold Value: ",ECTHLD
+7 WRITE !!,?1,"SSN",?13,"FACILITY",?24,"DSS UNIT",?55,"DATE/TIME",?75,"PROCEDURE",?86,"VOLUME",?94,"PROVIDER"
+8 WRITE !,LN,!
+9 QUIT
+10 ;
SS ;SCROLL STOPS
+1 NEW JJ,SS
+2 IF $EXTRACT(IOST)="C"
SET SS=21-$Y
FOR JJ=1:1:SS
WRITE !
+3 IF $EXTRACT(IOST)="C"
IF PG>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+4 QUIT
