- 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 Mar 13, 2025@21:03:28 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 ;
