ECREDIT ;ALB/CMD - Event Capture Edit Log Report ;Nov 16, 2022@13:37:55
;;2.0;EVENT CAPTURE;**159**;8 May 96;Build 61
;
; Reference to ^TMP supported by SACC 2.3.2.5.1
; Reference to ^%DTC in ICR #10000
; Reference to ^XLFDT in ICR #10103
; Reference to GETS^DIQ in ICR #2056
;
EN ;Main entry point for report
N %H,ECRDT
S %H=$H D YX^%DTC S ECRDT=Y
K ^TMP($J,"ECREDIT"),^TMP($J,"ECRPT")
D GETREC(ECSORT)
D PRINT K ^TMP($J,"ECREDIT")
I ECPTYP="E" D Q
.S ^TMP($J,"ECRPT",1)="LOCATION^DSS UNIT(IEN #)^PATIENT^SSN^PROCEDURE^DATE OF PROCEDURE^PROVIDER NAME^ENTERED OR EDITED BY STAFF NAME"
.K ^TMP($J,"ECREDIT")
Q
;
GETREC(SORT) ; Loop through "ADT" xref of EVENT CAPTURE PATIENT (#721) file and find records to put on report
; Input:
; SORT - sort type
;
; Output: none
;
N ECNT ;record cnt
N ECL ;location cnt
N ECD ;DSS unit cnt
N ECDFN ;DFN
N ECLOCF ;Location IEN
N ECDSSF ;DSS unit IEN
N ECDT ;date index
N ECREC ;"0" node
N ECIEN ;IEN of file 721
N NUNIT,NLOC
S ECNT=0
;put locations and units into ien subscripted arrays
S JJ="" F S JJ=$O(ECLOC(JJ)) Q:JJ="" D
.S NLOC($P(ECLOC(JJ),"^",1))=$P(ECLOC(JJ),"^",2)
S JJ="" F S JJ=$O(ECDSSU(JJ)) Q:JJ="" D
.S NUNIT($P(ECDSSU(JJ),"^",1))=$P(ECDSSU(JJ),"^",2)
S ECDT=ECSD-.0001,ECED=ECED+.9999
F S ECDT=$O(^ECH("AC",ECDT)) Q:'ECDT Q:ECDT>ECED D
. S ECIEN="" F S ECIEN=$O(^ECH("AC",ECDT,ECIEN)) Q:'ECIEN D
.. S ECREC=$G(^ECH(ECIEN,0))
.. S ECLOCF=$P(ECREC,U,4),ECDSSF=$P(ECREC,U,7)
.. I '$D(NLOC(ECLOCF))!('$D(NUNIT(ECDSSF))) Q
.. D BLDTMP(ECIEN,SORT,.ECNT)
Q
;
BLDTMP(ECIEN,ECSRT,ECCNT) ;add record to list
; Input:
; ECIEN - IEN in the EVENT CAPTURE PATIENT (#721) file
; ECSRT - sort type "D" or "U"
; ECCNT - record counter
;
; Output:
; ^TMP($J,"ECREDIT",location,DSS unit,sort,count)
;
N ECLOCA,ECDSS,ECIENS,ECPRCDT,ECUSER,ECPAT,ECERR,ECPROCDT,ECPROC,ECPROV,ECSSN,ECREC,ECKEY
I +$G(ECIEN)>0 D
.S ECCNT=+$G(ECCNT)+1
.S ECIENS=ECIEN_","
.S ECREC=""
.D GETS^DIQ(721,ECIENS,"1;2;3;6;8;10;13","IE","ECREC","ECERR")
.S ECLOCA=$G(ECREC(721,ECIENS,3,"E")) ;Location
.S ECDSS=+$G(ECREC(721,ECIENS,6,"I")) ;DSS unit
.S ECPRCDT=+$G(ECREC(721,ECIENS,2,"I")) ;Procedure date/time
.S ECPROCDT=$$FMTE^XLFDT(ECPRCDT,"5DZ") ;Procedure date
.S ECUSER=ECREC(721,ECIENS,13,"E") ;Entered/edit by
.S ECPAT=$E($G(ECREC(721,ECIENS,1,"E")),1,30) ;Patient name
.S ECSSN=$E($$GETSSN^ECRDSSA(ECIEN),1,10) ;ssn
.S ECPROC=$E($$GETPROC^ECRDSSA($G(ECREC(721,ECIENS,8,"I"))),1,5) ;Proc. Code
.S ECPROV=$E($$GETPROV^ECRDSSA(ECIEN),1,30) ;Provider
.S ECREC=ECPAT_U_ECSSN_U_ECPROC_U_ECPROCDT_U_ECPROV_U_ECUSER
.S ECKEY=$S(ECSRT="D":ECPRCDT,1:ECUSER)
.S ^TMP($J,"ECREDIT",ECLOCA,ECDSS,ECKEY,ECCNT)=ECREC
.S ^TMP($J,"ECREDIT",ECLOCA)=$G(^TMP($J,"ECREDIT",ECLOCA))+1
.S ^TMP($J,"ECREDIT",ECLOCA,ECDSS)=$G(^TMP($J,"ECREDIT",ECLOCA,ECDSS))+1
Q
;
PRINT ;loop results array and format output
;
N ECCLOC ;current location
N ECPLOC ;previous location
N ECLOCNM ;location name
N ECCDSS ;current DSS unit
N ECPDSS ;previous DSS unit
N ECDSSNM ;DSS unit name
N ECCNT ;record count
N ECDAT ;procedure date/time
N ECRDT ;run date
N ECFDT ;from date
N ECTDT ;to date
N ECKEY ;sort key
N ECSRTBY ;sort type text
N ECREC ;tmp record data
N CNT,ECNT,PAGE
S ECRDT=$$FMTE^XLFDT($$NOW^XLFDT,"5DZ")
S ECFDT=$$FMTE^XLFDT($P(ECSD+.0001,"."),"5DZ")
S ECTDT=$$FMTE^XLFDT($P(ECED,"."),"5DZ")
S (ECCLOC,ECPLOC)="",ECNT=1
S ECSRTBY=$S(ECSORT="D":"Procedure Date",1:"Staff Name")
U IO
I '$D(^TMP($J,"ECREDIT")) D Q
.S ECCLOC=$O(ECLOC("")),ECCLOC=$P(ECLOC(ECCLOC),"^",2)
.D HDR W:ECPTYP'="E" !!,?12,"No data to report for the date range selected.",!!
F S ECCLOC=$O(^TMP($J,"ECREDIT",ECCLOC)) Q:ECCLOC="" D
.I ECCLOC'=ECPLOC D ;location changed
..S ECPLOC=ECCLOC
..I $G(^TMP($J,"ECREDIT",ECCLOC))=0 D HDR W:ECTYPE'="E" !!," ** No records found on Location that match selection criteria **" Q
..D HDR
.S (ECCDSS,ECPDSS,ECKEY,CNT)=""
.F S ECCDSS=$O(^TMP($J,"ECREDIT",ECCLOC,ECCDSS)) Q:'ECCDSS D
..I ECCDSS'=ECPDSS D Q ;dss unit changed
...S ECPDSS=ECCDSS
...D DSSHDR^ECCLIPRO(ECCDSS)
...I $G(^TMP($J,"ECREDIT",ECCLOC,ECCDSS))=0 D HDR W:ECPTYPE'="E" !,"** No records found on DSS Unit that match selection criteria **" Q
...S ECKEY=""
...F S ECKEY=$O(^TMP($J,"ECREDIT",ECCLOC,ECCDSS,ECKEY)) Q:ECKEY="" D
....S CNT=0
....F S CNT=$O(^TMP($J,"ECREDIT",ECCLOC,ECCDSS,ECKEY,CNT)) Q:CNT="" D
.....S ECREC=^TMP($J,"ECREDIT",ECCLOC,ECCDSS,ECKEY,CNT),ECNT=ECNT+1
.....I ECPTYP="E" S ^TMP($J,"ECRPT",ECNT)=ECCLOC_U_$$GETDSSN^ECRDSSA(ECCDSS,.ECDSSU)_"(IEN #"_ECCDSS_")"_U_ECREC Q ;Exported fields
.....W !,$P(ECREC,U),?32,$P(ECREC,U,2),?38,$P(ECREC,U,3),?50,$P(ECREC,U,4),?62,$P(ECREC,U,5),?98,$P(ECREC,U,6)
.....I $Y>(IOSL-8) D HDR
Q
;
HDR ; print heading
Q:ECPTYP="E"
W @IOF W:$G(PAGE) !
S PAGE=$G(PAGE)+1
W !?30,"EVENT CAPTURE EDIT LOG REPORT",?80,"Run Date: ",ECRDT,?122,"Page:",PAGE
W !!,?35,"For Location: ",ECCLOC
W !,?35,"Date Range: ",ECFDT," - ",ECTDT
W !,?35,"Sorted By: ",ECSRTBY,!
W !!,"PATIENT",?32,"SSN",?38,"PROCEDURE",?50,"DATE OF",?62,"PROVIDER",?98,"ENTERED/EDITED"
W !,?50,"PROCEDURE",?62,"NAME",?98,"BY STAFF NAME"
W !,$$REPEAT^XLFSTR("-",132)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECREDIT 5397 printed Sep 23, 2025@19:34:42 Page 2
ECREDIT ;ALB/CMD - Event Capture Edit Log Report ;Nov 16, 2022@13:37:55
+1 ;;2.0;EVENT CAPTURE;**159**;8 May 96;Build 61
+2 ;
+3 ; Reference to ^TMP supported by SACC 2.3.2.5.1
+4 ; Reference to ^%DTC in ICR #10000
+5 ; Reference to ^XLFDT in ICR #10103
+6 ; Reference to GETS^DIQ in ICR #2056
+7 ;
EN ;Main entry point for report
+1 NEW %H,ECRDT
+2 SET %H=$HOROLOG
DO YX^%DTC
SET ECRDT=Y
+3 KILL ^TMP($JOB,"ECREDIT"),^TMP($JOB,"ECRPT")
+4 DO GETREC(ECSORT)
+5 DO PRINT
KILL ^TMP($JOB,"ECREDIT")
+6 IF ECPTYP="E"
Begin DoDot:1
+7 SET ^TMP($JOB,"ECRPT",1)="LOCATION^DSS UNIT(IEN #)^PATIENT^SSN^PROCEDURE^DATE OF PROCEDURE^PROVIDER NAME^ENTERED OR EDITED BY STAFF NAME"
+8 KILL ^TMP($JOB,"ECREDIT")
End DoDot:1
QUIT
+9 QUIT
+10 ;
GETREC(SORT) ; Loop through "ADT" xref of EVENT CAPTURE PATIENT (#721) file and find records to put on report
+1 ; Input:
+2 ; SORT - sort type
+3 ;
+4 ; Output: none
+5 ;
+6 ;record cnt
NEW ECNT
+7 ;location cnt
NEW ECL
+8 ;DSS unit cnt
NEW ECD
+9 ;DFN
NEW ECDFN
+10 ;Location IEN
NEW ECLOCF
+11 ;DSS unit IEN
NEW ECDSSF
+12 ;date index
NEW ECDT
+13 ;"0" node
NEW ECREC
+14 ;IEN of file 721
NEW ECIEN
+15 NEW NUNIT,NLOC
+16 SET ECNT=0
+17 ;put locations and units into ien subscripted arrays
+18 SET JJ=""
FOR
SET JJ=$ORDER(ECLOC(JJ))
if JJ=""
QUIT
Begin DoDot:1
+19 SET NLOC($PIECE(ECLOC(JJ),"^",1))=$PIECE(ECLOC(JJ),"^",2)
End DoDot:1
+20 SET JJ=""
FOR
SET JJ=$ORDER(ECDSSU(JJ))
if JJ=""
QUIT
Begin DoDot:1
+21 SET NUNIT($PIECE(ECDSSU(JJ),"^",1))=$PIECE(ECDSSU(JJ),"^",2)
End DoDot:1
+22 SET ECDT=ECSD-.0001
SET ECED=ECED+.9999
+23 FOR
SET ECDT=$ORDER(^ECH("AC",ECDT))
if 'ECDT
QUIT
if ECDT>ECED
QUIT
Begin DoDot:1
+24 SET ECIEN=""
FOR
SET ECIEN=$ORDER(^ECH("AC",ECDT,ECIEN))
if 'ECIEN
QUIT
Begin DoDot:2
+25 SET ECREC=$GET(^ECH(ECIEN,0))
+26 SET ECLOCF=$PIECE(ECREC,U,4)
SET ECDSSF=$PIECE(ECREC,U,7)
+27 IF '$DATA(NLOC(ECLOCF))!('$DATA(NUNIT(ECDSSF)))
QUIT
+28 DO BLDTMP(ECIEN,SORT,.ECNT)
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
BLDTMP(ECIEN,ECSRT,ECCNT) ;add record to list
+1 ; Input:
+2 ; ECIEN - IEN in the EVENT CAPTURE PATIENT (#721) file
+3 ; ECSRT - sort type "D" or "U"
+4 ; ECCNT - record counter
+5 ;
+6 ; Output:
+7 ; ^TMP($J,"ECREDIT",location,DSS unit,sort,count)
+8 ;
+9 NEW ECLOCA,ECDSS,ECIENS,ECPRCDT,ECUSER,ECPAT,ECERR,ECPROCDT,ECPROC,ECPROV,ECSSN,ECREC,ECKEY
+10 IF +$GET(ECIEN)>0
Begin DoDot:1
+11 SET ECCNT=+$GET(ECCNT)+1
+12 SET ECIENS=ECIEN_","
+13 SET ECREC=""
+14 DO GETS^DIQ(721,ECIENS,"1;2;3;6;8;10;13","IE","ECREC","ECERR")
+15 ;Location
SET ECLOCA=$GET(ECREC(721,ECIENS,3,"E"))
+16 ;DSS unit
SET ECDSS=+$GET(ECREC(721,ECIENS,6,"I"))
+17 ;Procedure date/time
SET ECPRCDT=+$GET(ECREC(721,ECIENS,2,"I"))
+18 ;Procedure date
SET ECPROCDT=$$FMTE^XLFDT(ECPRCDT,"5DZ")
+19 ;Entered/edit by
SET ECUSER=ECREC(721,ECIENS,13,"E")
+20 ;Patient name
SET ECPAT=$EXTRACT($GET(ECREC(721,ECIENS,1,"E")),1,30)
+21 ;ssn
SET ECSSN=$EXTRACT($$GETSSN^ECRDSSA(ECIEN),1,10)
+22 ;Proc. Code
SET ECPROC=$EXTRACT($$GETPROC^ECRDSSA($GET(ECREC(721,ECIENS,8,"I"))),1,5)
+23 ;Provider
SET ECPROV=$EXTRACT($$GETPROV^ECRDSSA(ECIEN),1,30)
+24 SET ECREC=ECPAT_U_ECSSN_U_ECPROC_U_ECPROCDT_U_ECPROV_U_ECUSER
+25 SET ECKEY=$SELECT(ECSRT="D":ECPRCDT,1:ECUSER)
+26 SET ^TMP($JOB,"ECREDIT",ECLOCA,ECDSS,ECKEY,ECCNT)=ECREC
+27 SET ^TMP($JOB,"ECREDIT",ECLOCA)=$GET(^TMP($JOB,"ECREDIT",ECLOCA))+1
+28 SET ^TMP($JOB,"ECREDIT",ECLOCA,ECDSS)=$GET(^TMP($JOB,"ECREDIT",ECLOCA,ECDSS))+1
End DoDot:1
+29 QUIT
+30 ;
PRINT ;loop results array and format output
+1 ;
+2 ;current location
NEW ECCLOC
+3 ;previous location
NEW ECPLOC
+4 ;location name
NEW ECLOCNM
+5 ;current DSS unit
NEW ECCDSS
+6 ;previous DSS unit
NEW ECPDSS
+7 ;DSS unit name
NEW ECDSSNM
+8 ;record count
NEW ECCNT
+9 ;procedure date/time
NEW ECDAT
+10 ;run date
NEW ECRDT
+11 ;from date
NEW ECFDT
+12 ;to date
NEW ECTDT
+13 ;sort key
NEW ECKEY
+14 ;sort type text
NEW ECSRTBY
+15 ;tmp record data
NEW ECREC
+16 NEW CNT,ECNT,PAGE
+17 SET ECRDT=$$FMTE^XLFDT($$NOW^XLFDT,"5DZ")
+18 SET ECFDT=$$FMTE^XLFDT($PIECE(ECSD+.0001,"."),"5DZ")
+19 SET ECTDT=$$FMTE^XLFDT($PIECE(ECED,"."),"5DZ")
+20 SET (ECCLOC,ECPLOC)=""
SET ECNT=1
+21 SET ECSRTBY=$SELECT(ECSORT="D":"Procedure Date",1:"Staff Name")
+22 USE IO
+23 IF '$DATA(^TMP($JOB,"ECREDIT"))
Begin DoDot:1
+24 SET ECCLOC=$ORDER(ECLOC(""))
SET ECCLOC=$PIECE(ECLOC(ECCLOC),"^",2)
+25 DO HDR
if ECPTYP'="E"
WRITE !!,?12,"No data to report for the date range selected.",!!
End DoDot:1
QUIT
+26 FOR
SET ECCLOC=$ORDER(^TMP($JOB,"ECREDIT",ECCLOC))
if ECCLOC=""
QUIT
Begin DoDot:1
+27 ;location changed
IF ECCLOC'=ECPLOC
Begin DoDot:2
+28 SET ECPLOC=ECCLOC
+29 IF $GET(^TMP($JOB,"ECREDIT",ECCLOC))=0
DO HDR
if ECTYPE'="E"
WRITE !!," ** No records found on Location that match selection criteria **"
QUIT
+30 DO HDR
End DoDot:2
+31 SET (ECCDSS,ECPDSS,ECKEY,CNT)=""
+32 FOR
SET ECCDSS=$ORDER(^TMP($JOB,"ECREDIT",ECCLOC,ECCDSS))
if 'ECCDSS
QUIT
Begin DoDot:2
+33 ;dss unit changed
IF ECCDSS'=ECPDSS
Begin DoDot:3
+34 SET ECPDSS=ECCDSS
+35 DO DSSHDR^ECCLIPRO(ECCDSS)
+36 IF $GET(^TMP($JOB,"ECREDIT",ECCLOC,ECCDSS))=0
DO HDR
if ECPTYPE'="E"
WRITE !,"** No records found on DSS Unit that match selection criteria **"
QUIT
+37 SET ECKEY=""
+38 FOR
SET ECKEY=$ORDER(^TMP($JOB,"ECREDIT",ECCLOC,ECCDSS,ECKEY))
if ECKEY=""
QUIT
Begin DoDot:4
+39 SET CNT=0
+40 FOR
SET CNT=$ORDER(^TMP($JOB,"ECREDIT",ECCLOC,ECCDSS,ECKEY,CNT))
if CNT=""
QUIT
Begin DoDot:5
+41 SET ECREC=^TMP($JOB,"ECREDIT",ECCLOC,ECCDSS,ECKEY,CNT)
SET ECNT=ECNT+1
+42 ;Exported fields
IF ECPTYP="E"
SET ^TMP($JOB,"ECRPT",ECNT)=ECCLOC_U_$$GETDSSN^ECRDSSA(ECCDSS,.ECDSSU)_"(IEN #"_ECCDSS_")"_U_ECREC
QUIT
+43 WRITE !,$PIECE(ECREC,U),?32,$PIECE(ECREC,U,2),?38,$PIECE(ECREC,U,3),?50,$PIECE(ECREC,U,4),?62,$PIECE(ECREC,U,5),?98,$PIECE(ECREC,U,6)
+44 IF $Y>(IOSL-8)
DO HDR
End DoDot:5
End DoDot:4
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+45 QUIT
+46 ;
HDR ; print heading
+1 if ECPTYP="E"
QUIT
+2 WRITE @IOF
if $GET(PAGE)
WRITE !
+3 SET PAGE=$GET(PAGE)+1
+4 WRITE !?30,"EVENT CAPTURE EDIT LOG REPORT",?80,"Run Date: ",ECRDT,?122,"Page:",PAGE
+5 WRITE !!,?35,"For Location: ",ECCLOC
+6 WRITE !,?35,"Date Range: ",ECFDT," - ",ECTDT
+7 WRITE !,?35,"Sorted By: ",ECSRTBY,!
+8 WRITE !!,"PATIENT",?32,"SSN",?38,"PROCEDURE",?50,"DATE OF",?62,"PROVIDER",?98,"ENTERED/EDITED"
+9 WRITE !,?50,"PROCEDURE",?62,"NAME",?98,"BY STAFF NAME"
+10 WRITE !,$$REPEAT^XLFSTR("-",132)
+11 QUIT
+12 ;
