- ECXAECS ;ALB/JAP - ECS Extract Audit Report ;9/13/17 15:18
- ;;3.0;DSS EXTRACTS;**8,33,123,144,166**;Dec 22, 1997;Build 24
- ;
- EN ;entry point for ECS extract audit report
- N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,COUNT,CNT,ECXPORT ;144
- S ECXERR=0
- ;ecxaud=0 for 'extract' audit
- S ECXHEAD="ECS",ECXAUD=0
- W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- ;select extract
- D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- Q:ECXERR
- ;determine if facility is multidivisional for event capture
- S COUNT=0,ECXD="" F S ECXD=$O(^DIC(4,"LOC",ECXD)) Q:ECXD="" S COUNT=COUNT+1 ;144
- S ECXALL=1
- I COUNT>1 D ;144
- .W !!
- .S DIR(0)="Y",DIR("A")="Do you want the "_ECXHEAD_" extract audit report for all Locations"
- .S DIR("B")="NO" D ^DIR K DIR
- .I $G(DIRUT) S ECXERR=1 Q
- .;if y=0 i.e., 'no', then ecxall=0 i.e., 'selected'
- .S ECXALL=Y
- I ECXERR=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- ;select divisions/sites; all ec locations if ecxall=1
- S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
- D ECS^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
- I ECXERR=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- ;
- D LATE(.ECXARRAY,.ECXERR) ;166, Determine if there are late added records and if they should be included
- I ECXERR Q ;166, Stop if user exits
- ;determine output device and queue if requested
- W !
- S ECXPGM="PROCESS^ECXAECS",ECXDESC="ECS Extract Audit Report"
- S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")=""
- S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I ECXPORT D Q ;144
- .K ^TMP($J,"ECXPORT") ;144
- .S ^TMP($J,"ECXPORT",0)="LOCATION^EXTRACT LOG #^DSS UNIT^CATEGORY^PROCEDURE^VOLUME" ;144
- .S CNT=1 ;144
- .D PROCESS ;144
- .D EXPDISP^ECXUTL1 ;144
- .D ^ECXKILL ;144
- W !
- D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
- I ECXSAVE("POP")=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- I ECXSAVE("ZTSK")=0 D
- .K ECXSAVE,ECXPGM,ECXDESC
- .D PROCESS^ECXAECS
- I IO'=IO(0) D ^%ZISC
- D HOME^%ZIS
- D AUDIT^ECXKILL
- Q
- ;
- PROCESS ;process data in file #727.815
- N X,Y,W,DATA,DATE,DIV,IEN,UNIT,UNITN,CAT,CATN,VOL,PROC,PROCN,PIEN,PRI,PRXF,PRSYN,QQFLG,COUNT ;144
- K ^TMP($J,"ECXAUD")
- S (COUNT,QQFLG)=0 ;144
- S ECXEXT=ECXARRAY("EXTRACT"),ECXDEF=ECXARRAY("DEF")
- S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
- ;get run date in external format
- D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
- ;get records in date range
- S IEN="" F S IEN=$O(^ECX(727.815,"AC",ECXEXT,IEN)) Q:IEN="" D Q:QQFLG
- .S DATA=^ECX(727.815,IEN,0),DATE=$P(DATA,U,9),DIV=$P(DATA,U,4)
- .;convert free text date to fm internal format date
- .S $E(DATE,1,2)=$E(DATE,1,2)-17
- .Q:$L(DATE)<7 ;166
- .I ECXARRAY("LATE")=0 I $E(DATE,4,5)'=$E(ECXSTART,4,5) Q ;166, Don't include late records
- .I $E(DATE,4,5)=$E(ECXSTART,4,5) Q:(DATE<ECXSTART) Q:(DATE>ECXEND) ;166, only check date range if not a late record
- .;if location is among those selected, then tally event capture data
- .I $D(ECXDIV(DIV)) D Q:QQFLG
- ..S UNIT=$P(DATA,U,10),UNITN=$P($G(^ECD(UNIT,0)),U,1),UNIT(UNITN)=UNIT
- ..;if no category, then cat=0
- ..S CAT=+$P(DATA,U,11),CATN="" S:+CAT CATN=$P($G(^EC(726,CAT,0)),U,1) S:CATN="" CATN="Unknown"
- ..S VOL=$P(DATA,U,13) S:VOL="" VOL=1 S PROC=$E($P(DATA,U,12),1,5)
- ..I '$D(^TMP($J,"ECXAUD",DIV,UNITN,CATN,PROC)) S ^TMP($J,"ECXAUD",DIV,UNITN,CATN,PROC)=0
- ..S ^(PROC)=^TMP($J,"ECXAUD",DIV,UNITN,CATN,PROC)+VOL,COUNT=COUNT+1 ;144
- ..I $D(ZTQUEUED),(COUNT>499),'(COUNT#500),$$S^%ZTLOAD S QQFLG=1,ZTSTOP=1 K ZTREQ Q ;144
- ..;get the procedure name and setup in global array
- ..S PIEN=0,PROCN="" S:PROC'?5N PIEN=$O(^EC(725,"E",PROC,""))
- ..;procedures from file #725
- ..I +PIEN>0 D
- ...S PROCN=$P($G(^EC(725,PIEN,0)),U,1)
- ...S PRXF=PIEN_";EC(725,"
- ...S PRI=+$O(^ECJ("AP",DIV,UNIT,CAT,PRXF,0)),PRSYN=$P($G(^ECJ(PRI,"PRO")),U,2)
- ...I PRSYN]"" S PROCN=PRSYN
- ..;procedures from file #81
- ..I PIEN=0,PROCN="" D
- ...S PIEN=$$CODEN^ICPTCOD(PROC) I +PIEN>0 S PROCN=$P($$CPT^ICPTCOD(PROC,DATE),U,3)
- ...S PRXF=PIEN_";ICPT("
- ...S PRI=+$O(^ECJ("AP",DIV,UNIT,CAT,PRXF,0)),PRSYN=$P($G(^ECJ(PRI,"PRO")),U,2)
- ...I PRSYN]"" S PROCN=PRSYN
- ..S:PROCN="" PROCN="Unknown"
- ..S ^TMP($J,"ECXPROC",PROC)=PROCN
- ;print the report
- D PRINT
- I $G(ECXPORT) Q ;144 Stop processing as ECXKILL kills ^TMP($J
- D AUDIT^ECXKILL
- Q
- ;
- PRINT ;print event capture data by location/division and dss unit order
- N JJ,SS,P,PN,LN,NM,DIV,DIVNM,PG,QFLG,GTOT,PROC,STOT,TOT,DIR,DIRUT,DTOUT,DUOUT
- U IO
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
- S (QFLG,PG)=0,$P(LN,"-",80)="",DIV=""
- F S DIV=$O(ECXDIV(DIV)) Q:DIV="" D Q:QFLG
- .S DIVNM=$P(ECXDIV(DIV),U,2)_" ("_DIV_")",GTOT=0 I '$G(ECXPORT) D HEADER ;144
- .I '$D(^TMP($J,"ECXAUD",DIV)) D Q
- ..I $G(ECXPORT) Q ;144 Don't print if exporting
- ..W !!,?5,"No data available for this Event Capture Location.",!!
- .I $D(^TMP($J,"ECXAUD",DIV)) S UNITN="" F S UNITN=$O(^TMP($J,"ECXAUD",DIV,UNITN)) Q:UNITN="" D Q:QFLG
- ..S STOT=0,UNIT=UNIT(UNITN),CATN=""
- ..;write the unit name
- ..I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG W !,UNITN_" ("_UNIT_")",! ;144 Don't print if exporting
- ..;initialize the proc array and set totals in array
- ..F S CATN=$O(^TMP($J,"ECXAUD",DIV,UNITN,CATN)) Q:CATN="" K PROC S PROC="" D Q:QFLG
- ...;write the category name
- ...I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG W !,?5,$E(CATN,1,25) ;144 Don't print if exporting
- ...F S PROC=$O(^TMP($J,"ECXAUD",DIV,UNITN,CATN,PROC)) Q:PROC="" S TOT=^(PROC) D
- ....S STOT=STOT+TOT,GTOT=GTOT+TOT,PROCN=""
- ....I $D(^TMP($J,"ECXPROC",PROC)) S PROCN=^(PROC)
- ....S PROC($$LJ^XLFSTR(PROC,6," ")_" "_PROCN)=TOT
- ...S PN="" F S PN=$O(PROC(PN)) Q:PN="" S TOT=PROC(PN) D Q:QFLG
- ....I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=DIVNM_U_ECXARRAY("EXTRACT")_U_UNITN_" ("_UNIT_")"_U_CATN_U_PN_U_TOT,CNT=CNT+1 Q ;144
- ....;write procedure and total
- ....W ?35,$E(PN,1,30),?68,$$RJ^XLFSTR(TOT,5," "),!
- ..I $G(ECXPORT) Q ;144 Stop processing if exporting
- ..;write the unit subtotal
- ..D:($Y+3>IOSL) HEADER Q:QFLG W !,?5,$E(LN,1,74)
- ..W !,"Total Volume for Unit "_UNITN_" ("_UNIT_"):",?68,$$RJ^XLFSTR(STOT,5," "),!
- .I $G(ECXPORT) Q ;144 Stop processing if exporting
- .;write the division grandtotal
- .D:($Y+3>IOSL) HEADER Q:QFLG W !!,"Grand Total for Location "_DIVNM_":",?68,$$RJ^XLFSTR(GTOT,5," ")
- ;print the audit descriptive narrative
- I $G(ECXPORT) Q ;144 Stop processing if exporting
- I $E(IOST)'="C" D
- .W @IOF S PG=PG+1
- .W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- .W !,"DSS Extract Log #: "_ECXEXT
- .W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- .W !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG
- .W !!,LN,!!
- .S DIC="^ECX(727.1,",DA=ECXARRAY("DEF"),DR="1" D EN^DIQ
- I $E(IOST)="C",'QFLG D
- .S SS=22-$Y F JJ=1:1:SS W !
- .S DIR(0)="E" W ! D ^DIR K DIR
- Q
- ;
- 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!($E(IOST)="C") @IOF S PG=PG+1
- W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- W !,"DSS Extract Log #: "_ECXARRAY("EXTRACT")
- W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- W !,"Report Run Date/Time: "_ECXRUN
- W !,"Event Capture Location: "_$P(ECXDIV(DIV),U,2)_" ("_DIV_")",?68,"Page: "_PG
- W !!,"DSS Unit",!,?5,"Category",?35,"Procedure",?68,"Volume"
- W !,LN,!
- Q
- ;166 Section added to determine if there are any late records in
- ;the extract. If there are, prompt for inclusion in report
- LATE(ARRAY,ECXERR) ;
- N LREC,LDATE,DIR,DIRUT,X,Y
- S ARRAY("LATE")=0 ;Assume late records will not be included
- S LREC=$O(^ECX(727.815,"AC",+$G(ARRAY("EXTRACT")),""),-1) ;Finds record number of last entry in extract
- S LDATE=$P(^ECX(727.815,+LREC,0),U,9) ;Gets procedure date of last entry in extract
- S $E(LDATE,1,2)=$E(LDATE,1,2)-17 ;Convert DSS style date to FM internal date
- I LDATE D ;If date found, check to see if it's late
- .I $E(LDATE,4,5)'=$E(ECXSTART,4,5) D
- ..W !!
- ..S DIR(0)="Y",DIR("A")="Do you want to include 'late' State Home records in this report",DIR("B")="Y"
- ..S DIR("?",1)="This extract contains late entered State Home records.",DIR("?")="Indicate if the extract audit report should include these records." D ^DIR
- ..I Y S ARRAY("LATE")=1 ;Allow for late records
- ..I $G(DIRUT) S ECXERR=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXAECS 8513 printed Feb 18, 2025@23:18:20 Page 2
- ECXAECS ;ALB/JAP - ECS Extract Audit Report ;9/13/17 15:18
- +1 ;;3.0;DSS EXTRACTS;**8,33,123,144,166**;Dec 22, 1997;Build 24
- +2 ;
- EN ;entry point for ECS extract audit report
- +1 ;144
- NEW %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,COUNT,CNT,ECXPORT
- +2 SET ECXERR=0
- +3 ;ecxaud=0 for 'extract' audit
- +4 SET ECXHEAD="ECS"
- SET ECXAUD=0
- +5 WRITE !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- +6 ;select extract
- +7 DO AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- +8 if ECXERR
- QUIT
- +9 ;determine if facility is multidivisional for event capture
- +10 ;144
- SET COUNT=0
- SET ECXD=""
- FOR
- SET ECXD=$ORDER(^DIC(4,"LOC",ECXD))
- if ECXD=""
- QUIT
- SET COUNT=COUNT+1
- +11 SET ECXALL=1
- +12 ;144
- IF COUNT>1
- Begin DoDot:1
- +13 WRITE !!
- +14 SET DIR(0)="Y"
- SET DIR("A")="Do you want the "_ECXHEAD_" extract audit report for all Locations"
- +15 SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +16 IF $GET(DIRUT)
- SET ECXERR=1
- QUIT
- +17 ;if y=0 i.e., 'no', then ecxall=0 i.e., 'selected'
- +18 SET ECXALL=Y
- End DoDot:1
- +19 IF ECXERR=1
- Begin DoDot:1
- +20 WRITE !!,?5,"Try again later... exiting.",!
- +21 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +22 ;select divisions/sites; all ec locations if ecxall=1
- +23 SET X=ECXARRAY("START")
- DO ^%DT
- SET ECXSTART=Y
- SET X=ECXARRAY("END")
- DO ^%DT
- SET ECXEND=Y
- +24 DO ECS^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
- +25 IF ECXERR=1
- Begin DoDot:1
- +26 WRITE !!,?5,"Try again later... exiting.",!
- +27 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +28 ;
- +29 ;166, Determine if there are late added records and if they should be included
- DO LATE(.ECXARRAY,.ECXERR)
- +30 ;166, Stop if user exits
- IF ECXERR
- QUIT
- +31 ;determine output device and queue if requested
- +32 WRITE !
- +33 SET ECXPGM="PROCESS^ECXAECS"
- SET ECXDESC="ECS Extract Audit Report"
- +34 SET ECXSAVE("ECXHEAD")=""
- SET ECXSAVE("ECXALL")=""
- SET ECXSAVE("ECXDIV(")=""
- SET ECXSAVE("ECXARRAY(")=""
- +35 ;144
- SET ECXPORT=$$EXPORT^ECXUTL1
- if ECXPORT=-1
- QUIT
- IF ECXPORT
- Begin DoDot:1
- +36 ;144
- KILL ^TMP($JOB,"ECXPORT")
- +37 ;144
- SET ^TMP($JOB,"ECXPORT",0)="LOCATION^EXTRACT LOG #^DSS UNIT^CATEGORY^PROCEDURE^VOLUME"
- +38 ;144
- SET CNT=1
- +39 ;144
- DO PROCESS
- +40 ;144
- DO EXPDISP^ECXUTL1
- +41 ;144
- DO ^ECXKILL
- End DoDot:1
- QUIT
- +42 WRITE !
- +43 DO DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
- +44 IF ECXSAVE("POP")=1
- Begin DoDot:1
- +45 WRITE !!,?5,"Try again later... exiting.",!
- +46 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +47 IF ECXSAVE("ZTSK")=0
- Begin DoDot:1
- +48 KILL ECXSAVE,ECXPGM,ECXDESC
- +49 DO PROCESS^ECXAECS
- End DoDot:1
- +50 IF IO'=IO(0)
- DO ^%ZISC
- +51 DO HOME^%ZIS
- +52 DO AUDIT^ECXKILL
- +53 QUIT
- +54 ;
- PROCESS ;process data in file #727.815
- +1 ;144
- NEW X,Y,W,DATA,DATE,DIV,IEN,UNIT,UNITN,CAT,CATN,VOL,PROC,PROCN,PIEN,PRI,PRXF,PRSYN,QQFLG,COUNT
- +2 KILL ^TMP($JOB,"ECXAUD")
- +3 ;144
- SET (COUNT,QQFLG)=0
- +4 SET ECXEXT=ECXARRAY("EXTRACT")
- SET ECXDEF=ECXARRAY("DEF")
- +5 SET X=ECXARRAY("START")
- DO ^%DT
- SET ECXSTART=Y
- SET X=ECXARRAY("END")
- DO ^%DT
- SET ECXEND=Y
- +6 ;get run date in external format
- +7 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- DO DD^%DT
- SET ECXRUN=Y
- +8 ;get records in date range
- +9 SET IEN=""
- FOR
- SET IEN=$ORDER(^ECX(727.815,"AC",ECXEXT,IEN))
- if IEN=""
- QUIT
- Begin DoDot:1
- +10 SET DATA=^ECX(727.815,IEN,0)
- SET DATE=$PIECE(DATA,U,9)
- SET DIV=$PIECE(DATA,U,4)
- +11 ;convert free text date to fm internal format date
- +12 SET $EXTRACT(DATE,1,2)=$EXTRACT(DATE,1,2)-17
- +13 ;166
- if $LENGTH(DATE)<7
- QUIT
- +14 ;166, Don't include late records
- IF ECXARRAY("LATE")=0
- IF $EXTRACT(DATE,4,5)'=$EXTRACT(ECXSTART,4,5)
- QUIT
- +15 ;166, only check date range if not a late record
- IF $EXTRACT(DATE,4,5)=$EXTRACT(ECXSTART,4,5)
- if (DATE<ECXSTART)
- QUIT
- if (DATE>ECXEND)
- QUIT
- +16 ;if location is among those selected, then tally event capture data
- +17 IF $DATA(ECXDIV(DIV))
- Begin DoDot:2
- +18 SET UNIT=$PIECE(DATA,U,10)
- SET UNITN=$PIECE($GET(^ECD(UNIT,0)),U,1)
- SET UNIT(UNITN)=UNIT
- +19 ;if no category, then cat=0
- +20 SET CAT=+$PIECE(DATA,U,11)
- SET CATN=""
- if +CAT
- SET CATN=$PIECE($GET(^EC(726,CAT,0)),U,1)
- if CATN=""
- SET CATN="Unknown"
- +21 SET VOL=$PIECE(DATA,U,13)
- if VOL=""
- SET VOL=1
- SET PROC=$EXTRACT($PIECE(DATA,U,12),1,5)
- +22 IF '$DATA(^TMP($JOB,"ECXAUD",DIV,UNITN,CATN,PROC))
- SET ^TMP($JOB,"ECXAUD",DIV,UNITN,CATN,PROC)=0
- +23 ;144
- SET ^(PROC)=^TMP($JOB,"ECXAUD",DIV,UNITN,CATN,PROC)+VOL
- SET COUNT=COUNT+1
- +24 ;144
- IF $DATA(ZTQUEUED)
- IF (COUNT>499)
- IF '(COUNT#500)
- IF $$S^%ZTLOAD
- SET QQFLG=1
- SET ZTSTOP=1
- KILL ZTREQ
- QUIT
- +25 ;get the procedure name and setup in global array
- +26 SET PIEN=0
- SET PROCN=""
- if PROC'?5N
- SET PIEN=$ORDER(^EC(725,"E",PROC,""))
- +27 ;procedures from file #725
- +28 IF +PIEN>0
- Begin DoDot:3
- +29 SET PROCN=$PIECE($GET(^EC(725,PIEN,0)),U,1)
- +30 SET PRXF=PIEN_";EC(725,"
- +31 SET PRI=+$ORDER(^ECJ("AP",DIV,UNIT,CAT,PRXF,0))
- SET PRSYN=$PIECE($GET(^ECJ(PRI,"PRO")),U,2)
- +32 IF PRSYN]""
- SET PROCN=PRSYN
- End DoDot:3
- +33 ;procedures from file #81
- +34 IF PIEN=0
- IF PROCN=""
- Begin DoDot:3
- +35 SET PIEN=$$CODEN^ICPTCOD(PROC)
- IF +PIEN>0
- SET PROCN=$PIECE($$CPT^ICPTCOD(PROC,DATE),U,3)
- +36 SET PRXF=PIEN_";ICPT("
- +37 SET PRI=+$ORDER(^ECJ("AP",DIV,UNIT,CAT,PRXF,0))
- SET PRSYN=$PIECE($GET(^ECJ(PRI,"PRO")),U,2)
- +38 IF PRSYN]""
- SET PROCN=PRSYN
- End DoDot:3
- +39 if PROCN=""
- SET PROCN="Unknown"
- +40 SET ^TMP($JOB,"ECXPROC",PROC)=PROCN
- End DoDot:2
- if QQFLG
- QUIT
- End DoDot:1
- if QQFLG
- QUIT
- +41 ;print the report
- +42 DO PRINT
- +43 ;144 Stop processing as ECXKILL kills ^TMP($J
- IF $GET(ECXPORT)
- QUIT
- +44 DO AUDIT^ECXKILL
- +45 QUIT
- +46 ;
- PRINT ;print event capture data by location/division and dss unit order
- +1 NEW JJ,SS,P,PN,LN,NM,DIV,DIVNM,PG,QFLG,GTOT,PROC,STOT,TOT,DIR,DIRUT,DTOUT,DUOUT
- +2 USE IO
- +3 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- QUIT
- +4 SET (QFLG,PG)=0
- SET $PIECE(LN,"-",80)=""
- SET DIV=""
- +5 FOR
- SET DIV=$ORDER(ECXDIV(DIV))
- if DIV=""
- QUIT
- Begin DoDot:1
- +6 ;144
- SET DIVNM=$PIECE(ECXDIV(DIV),U,2)_" ("_DIV_")"
- SET GTOT=0
- IF '$GET(ECXPORT)
- DO HEADER
- +7 IF '$DATA(^TMP($JOB,"ECXAUD",DIV))
- Begin DoDot:2
- +8 ;144 Don't print if exporting
- IF $GET(ECXPORT)
- QUIT
- +9 WRITE !!,?5,"No data available for this Event Capture Location.",!!
- End DoDot:2
- QUIT
- +10 IF $DATA(^TMP($JOB,"ECXAUD",DIV))
- SET UNITN=""
- FOR
- SET UNITN=$ORDER(^TMP($JOB,"ECXAUD",DIV,UNITN))
- if UNITN=""
- QUIT
- Begin DoDot:2
- +11 SET STOT=0
- SET UNIT=UNIT(UNITN)
- SET CATN=""
- +12 ;write the unit name
- +13 ;144 Don't print if exporting
- IF '$GET(ECXPORT)
- if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,UNITN_" ("_UNIT_")",!
- +14 ;initialize the proc array and set totals in array
- +15 FOR
- SET CATN=$ORDER(^TMP($JOB,"ECXAUD",DIV,UNITN,CATN))
- if CATN=""
- QUIT
- KILL PROC
- SET PROC=""
- Begin DoDot:3
- +16 ;write the category name
- +17 ;144 Don't print if exporting
- IF '$GET(ECXPORT)
- if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,?5,$EXTRACT(CATN,1,25)
- +18 FOR
- SET PROC=$ORDER(^TMP($JOB,"ECXAUD",DIV,UNITN,CATN,PROC))
- if PROC=""
- QUIT
- SET TOT=^(PROC)
- Begin DoDot:4
- +19 SET STOT=STOT+TOT
- SET GTOT=GTOT+TOT
- SET PROCN=""
- +20 IF $DATA(^TMP($JOB,"ECXPROC",PROC))
- SET PROCN=^(PROC)
- +21 SET PROC($$LJ^XLFSTR(PROC,6," ")_" "_PROCN)=TOT
- End DoDot:4
- +22 SET PN=""
- FOR
- SET PN=$ORDER(PROC(PN))
- if PN=""
- QUIT
- SET TOT=PROC(PN)
- Begin DoDot:4
- +23 ;144
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",CNT)=DIVNM_U_ECXARRAY("EXTRACT")_U_UNITN_" ("_UNIT_")"_U_CATN_U_PN_U_TOT
- SET CNT=CNT+1
- QUIT
- +24 ;write procedure and total
- +25 WRITE ?35,$EXTRACT(PN,1,30),?68,$$RJ^XLFSTR(TOT,5," "),!
- End DoDot:4
- if QFLG
- QUIT
- End DoDot:3
- if QFLG
- QUIT
- +26 ;144 Stop processing if exporting
- IF $GET(ECXPORT)
- QUIT
- +27 ;write the unit subtotal
- +28 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,?5,$EXTRACT(LN,1,74)
- +29 WRITE !,"Total Volume for Unit "_UNITN_" ("_UNIT_"):",?68,$$RJ^XLFSTR(STOT,5," "),!
- End DoDot:2
- if QFLG
- QUIT
- +30 ;144 Stop processing if exporting
- IF $GET(ECXPORT)
- QUIT
- +31 ;write the division grandtotal
- +32 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !!,"Grand Total for Location "_DIVNM_":",?68,$$RJ^XLFSTR(GTOT,5," ")
- End DoDot:1
- if QFLG
- QUIT
- +33 ;print the audit descriptive narrative
- +34 ;144 Stop processing if exporting
- IF $GET(ECXPORT)
- QUIT
- +35 IF $EXTRACT(IOST)'="C"
- Begin DoDot:1
- +36 WRITE @IOF
- SET PG=PG+1
- +37 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- +38 WRITE !,"DSS Extract Log #: "_ECXEXT
- +39 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- +40 WRITE !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG
- +41 WRITE !!,LN,!!
- +42 SET DIC="^ECX(727.1,"
- SET DA=ECXARRAY("DEF")
- SET DR="1"
- DO EN^DIQ
- End DoDot:1
- +43 IF $EXTRACT(IOST)="C"
- IF 'QFLG
- Begin DoDot:1
- +44 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +45 SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- +46 QUIT
- +47 ;
- +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!($EXTRACT(IOST)="C")
- WRITE @IOF
- SET PG=PG+1
- +7 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- +8 WRITE !,"DSS Extract Log #: "_ECXARRAY("EXTRACT")
- +9 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- +10 WRITE !,"Report Run Date/Time: "_ECXRUN
- +11 WRITE !,"Event Capture Location: "_$PIECE(ECXDIV(DIV),U,2)_" ("_DIV_")",?68,"Page: "_PG
- +12 WRITE !!,"DSS Unit",!,?5,"Category",?35,"Procedure",?68,"Volume"
- +13 WRITE !,LN,!
- +14 QUIT
- +15 ;166 Section added to determine if there are any late records in
- +16 ;the extract. If there are, prompt for inclusion in report
- LATE(ARRAY,ECXERR) ;
- +1 NEW LREC,LDATE,DIR,DIRUT,X,Y
- +2 ;Assume late records will not be included
- SET ARRAY("LATE")=0
- +3 ;Finds record number of last entry in extract
- SET LREC=$ORDER(^ECX(727.815,"AC",+$GET(ARRAY("EXTRACT")),""),-1)
- +4 ;Gets procedure date of last entry in extract
- SET LDATE=$PIECE(^ECX(727.815,+LREC,0),U,9)
- +5 ;Convert DSS style date to FM internal date
- SET $EXTRACT(LDATE,1,2)=$EXTRACT(LDATE,1,2)-17
- +6 ;If date found, check to see if it's late
- IF LDATE
- Begin DoDot:1
- +7 IF $EXTRACT(LDATE,4,5)'=$EXTRACT(ECXSTART,4,5)
- Begin DoDot:2
- +8 WRITE !!
- +9 SET DIR(0)="Y"
- SET DIR("A")="Do you want to include 'late' State Home records in this report"
- SET DIR("B")="Y"
- +10 SET DIR("?",1)="This extract contains late entered State Home records."
- SET DIR("?")="Indicate if the extract audit report should include these records."
- DO ^DIR
- +11 ;Allow for late records
- IF Y
- SET ARRAY("LATE")=1
- +12 IF $GET(DIRUT)
- SET ECXERR=1
- End DoDot:2
- End DoDot:1
- +13 QUIT