ECCLIPRO ;ALB/CMD - Event Capture Procedure by Clinic Report ;Nov 16, 2022@13:39:46
;;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
; Reference to $$LJ^XLFSTR in ICR #10104
;
EN ;Main entry point for report
N %H,ECRDT,Y
S %H=$H D YX^%DTC S ECRDT=Y
K ^TMP($J,"ECCLIPRO"),^TMP($J,"ECRPT")
D PROCESS
D PRINT K ^TMP($J,"ECCLIPRO")
I ECPTYP="E" D Q
.S ^TMP($J,"ECRPT",1)="LOCATION^DSS UNIT(IEN #)^CLINIC^PATIENT^SSN^DATE OF PROCEDURE^PROCEDURE CODE^PROCEDURE NAME^VOLUME^PROVIDER NAME"
.K ^TMP($J,"ECCLIPRO")
Q
;
PROCESS ;Loop through "AC1" xref of EVENT CAPTURE PATIENT (#721) file and find records to put on report
N ECCLIN,ECPA,ECR,ECRL,ECREC,ECRN,ECSSN,ECLOCNM
N ECUNIT,ECFILE,ECPRV,ECPRVN,ECDFN,ECDT,ECEDT,ECIEN,ECLOCF
N NUNIT,JJ,ECRSNUM,ECPI,ECPROCNM
S JJ="" F S JJ=$O(ECDSSU(JJ)) Q:JJ="" D
.S NUNIT($P(ECDSSU(JJ),U))=$P(ECDSSU(JJ),U,2)
S ECDT=ECSD-.0001,ECEDT=ECED+.9999
F S ECDT=$O(^ECH("AC1",ECLOC,ECDT)) Q:'ECDT Q:ECDT>ECEDT D
.S ECIEN="" F S ECIEN=$O(^ECH("AC1",ECLOC,ECDT,ECIEN)) Q:'ECIEN D
..S ECREC=$G(^ECH(ECIEN,0))
..S ECCLIN=$P(ECREC,U,19),ECLOCF=$P(ECREC,U,4),ECDSSF=$P(ECREC,U,7)
..I ECLOCF'=ECLOC Q
..I '$D(NUNIT(ECDSSF)) Q
..I ECCLIN'=ECCLI Q
..D BLDTMP(ECIEN,ECSORT)
Q
;
BLDTMP(IEN,SORT) ; Add record to the list
N ECDSS,ECIENS,ECPRCDT,ECPROCDT,ECPROCN,ECUSER,ECDT,ECPAT,ECERR,ECPROC,ECPROV,ECSSN,ECVOL
N ECREC,SRTKEY
I +$G(IEN)>0 D
.S ECIENS=IEN_","
.S ECREC=""
.D GETS^DIQ(721,ECIENS,"1;2;6;8;9;10","IE","ECREC","ECERR")
.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 ECPAT=$E($G(ECREC(721,ECIENS,1,"E")),1,30) ;patient name
.S ECSSN=$E($$GETSSN^ECRDSSA(IEN),1,10) ;ssn
.S ECVOL=+$G(ECREC(721,ECIENS,9,"I")) ;Volume
.S ECPROC=$G(ECREC(721,ECIENS,8,"I")) ;Procedure Code
.S ECPROC=$E($$GETPROC^ECRDSSA($G(ECREC(721,ECIENS,8,"I"))),1,5) ;proc.code
.S ECPROCN=$$GETPRNM^ECRDSSA($G(ECREC(721,ECIENS,8,"I")),ECPROCDT) ;Procedure Name
.S ECPROCN=$E(ECPROCN,1,25)
.S ECPROV=$E($$GETPROV^ECRDSSA(IEN),1,30) ;provider
.S ECREC=ECPAT_U_ECSSN_U_$$FMTE^XLFDT(ECPRCDT,"2MZ")_U_ECPROC_U_ECPROCN_U_ECVOL_U_ECPROV
.S SRTKEY=$S(SORT="P":ECPAT,1:ECPRCDT)
.S ^TMP($J,"ECCLIPRO",ECLOC,ECDSS,SRTKEY,ECPROC,IEN)=ECREC
Q
;
PRINT ;loop the temp global and format output
N ECSRTBY,ECSKEY,ECREC,ECRDT,ECFDT,ECTDT,ECDAT,ECPRCDT,ECKEY,ECDSS,ECPDSS,ECPROC
N CNT,PAGE,LOCNM,LIEN,PROC,PROCDT,CLIEN,CLINM,ECIEN
S LIEN=ECLOC_","
S CLIEN=ECCLI_","
S ECRDT=$$FMTE^XLFDT($$NOW^XLFDT,"5DZ")
S ECFDT=$$FMTE^XLFDT($P(ECSD+.0001,"."),"5DZ")
S ECTDT=$$FMTE^XLFDT($P(ECED,"."),"5DZ")
S ECSRTBY=$S(ECSORT="D":"Procedure Date",1:"Patient Name")
S LOCNM=$$GET1^DIQ(4,LIEN,.01) ;Location Name
S CLINM=$$GET1^DIQ(44,CLIEN,.01) ;Clinic Name
U IO
I '$D(^TMP($J,"ECCLIPRO")) D Q
.I ECPTYP'="E" D HDR W !!,?12,"No data to report for the date range selected.",!!
D HDR
S ECDSS="",ECPDSS="",CNT=1
F S ECDSS=$O(^TMP($J,"ECCLIPRO",ECLOC,ECDSS)) Q:ECDSS="" D
.I $Y>(IOSL-8) D HDR
.I ECDSS'=ECPDSS D DSSHDR(ECDSS) S ECPDSS=ECDSS
.S ECSKEY="" F S ECSKEY=$O(^TMP($J,"ECCLIPRO",ECLOC,ECDSS,ECSKEY)) Q:ECSKEY="" D
..S ECPROC="" F S ECPROC=$O(^TMP($J,"ECCLIPRO",ECLOC,ECDSS,ECSKEY,ECPROC)) Q:ECPROC="" D
...S ECIEN="" F S ECIEN=$O(^TMP($J,"ECCLIPRO",ECLOC,ECDSS,ECSKEY,ECPROC,ECIEN)) Q:ECIEN="" D
....S ECREC=^TMP($J,"ECCLIPRO",ECLOC,ECDSS,ECSKEY,ECPROC,ECIEN)
....I ECPTYP="E" S ^TMP($J,"ECRPT",CNT+1)=LOCNM_U_$$GETDSSN^ECRDSSA(ECDSS,.ECDSSU)_"(IEN #"_ECDSS_")"_U_CLINM_U_ECREC,CNT=CNT+1 Q ;Exported fields
....W !,$P(ECREC,U),?32,$P(ECREC,U,2),?38,$TR($P(ECREC,U,3),":"),?53,ECPROC,?59,$P(ECREC,U,5),?88,$J($P(ECREC,U,6),4),?98,$P(ECREC,U,7)
Q
;
HDR ; Print the header
Q:ECPTYP="E"
W @IOF W:$G(PAGE) !
S PAGE=$G(PAGE)+1
W !?30,"EVENT CAPTURE PROCEDURES BY CLINIC REPORT",?80,"Run Date: ",ECRDT,?122,"Page:",PAGE
W !!,?35,"For Location: ",LOCNM
W !,?35,"Date Range: ",ECFDT," - ",ECTDT
W !,?35,"Clinic: ",CLINM
W !,?35,"Sorted By: ",ECSRTBY
W !!,"Patient",?32,"SSN",?38,"Procedure",?53,"Procedure",?86,"Procedure",?98,"Provider",!
W ?38,"Date/Time",?53,"Code",?59,"Name",?88,"Volume",!
W !,$$REPEAT^XLFSTR("-",132)
Q
;
DSSHDR(ECDSS) ; Print DSS Line
N DSSNM
Q:ECPTYP="E"
S DSSNM=$$GETDSSN^ECRDSSA(ECDSS,.ECDSSU)
I $Y>(IOSL-8) D HDR
D DSSHDR^ECRDSSA(ECDSS,DSSNM)
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECCLIPRO 4633 printed Dec 13, 2024@01:57 Page 2
ECCLIPRO ;ALB/CMD - Event Capture Procedure by Clinic Report ;Nov 16, 2022@13:39:46
+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 ; Reference to $$LJ^XLFSTR in ICR #10104
+8 ;
EN ;Main entry point for report
+1 NEW %H,ECRDT,Y
+2 SET %H=$HOROLOG
DO YX^%DTC
SET ECRDT=Y
+3 KILL ^TMP($JOB,"ECCLIPRO"),^TMP($JOB,"ECRPT")
+4 DO PROCESS
+5 DO PRINT
KILL ^TMP($JOB,"ECCLIPRO")
+6 IF ECPTYP="E"
Begin DoDot:1
+7 SET ^TMP($JOB,"ECRPT",1)="LOCATION^DSS UNIT(IEN #)^CLINIC^PATIENT^SSN^DATE OF PROCEDURE^PROCEDURE CODE^PROCEDURE NAME^VOLUME^PROVIDER NAME"
+8 KILL ^TMP($JOB,"ECCLIPRO")
End DoDot:1
QUIT
+9 QUIT
+10 ;
PROCESS ;Loop through "AC1" xref of EVENT CAPTURE PATIENT (#721) file and find records to put on report
+1 NEW ECCLIN,ECPA,ECR,ECRL,ECREC,ECRN,ECSSN,ECLOCNM
+2 NEW ECUNIT,ECFILE,ECPRV,ECPRVN,ECDFN,ECDT,ECEDT,ECIEN,ECLOCF
+3 NEW NUNIT,JJ,ECRSNUM,ECPI,ECPROCNM
+4 SET JJ=""
FOR
SET JJ=$ORDER(ECDSSU(JJ))
if JJ=""
QUIT
Begin DoDot:1
+5 SET NUNIT($PIECE(ECDSSU(JJ),U))=$PIECE(ECDSSU(JJ),U,2)
End DoDot:1
+6 SET ECDT=ECSD-.0001
SET ECEDT=ECED+.9999
+7 FOR
SET ECDT=$ORDER(^ECH("AC1",ECLOC,ECDT))
if 'ECDT
QUIT
if ECDT>ECEDT
QUIT
Begin DoDot:1
+8 SET ECIEN=""
FOR
SET ECIEN=$ORDER(^ECH("AC1",ECLOC,ECDT,ECIEN))
if 'ECIEN
QUIT
Begin DoDot:2
+9 SET ECREC=$GET(^ECH(ECIEN,0))
+10 SET ECCLIN=$PIECE(ECREC,U,19)
SET ECLOCF=$PIECE(ECREC,U,4)
SET ECDSSF=$PIECE(ECREC,U,7)
+11 IF ECLOCF'=ECLOC
QUIT
+12 IF '$DATA(NUNIT(ECDSSF))
QUIT
+13 IF ECCLIN'=ECCLI
QUIT
+14 DO BLDTMP(ECIEN,ECSORT)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
BLDTMP(IEN,SORT) ; Add record to the list
+1 NEW ECDSS,ECIENS,ECPRCDT,ECPROCDT,ECPROCN,ECUSER,ECDT,ECPAT,ECERR,ECPROC,ECPROV,ECSSN,ECVOL
+2 NEW ECREC,SRTKEY
+3 IF +$GET(IEN)>0
Begin DoDot:1
+4 SET ECIENS=IEN_","
+5 SET ECREC=""
+6 DO GETS^DIQ(721,ECIENS,"1;2;6;8;9;10","IE","ECREC","ECERR")
+7 ;DSS unit
SET ECDSS=+$GET(ECREC(721,ECIENS,6,"I"))
+8 ;procedure date/time
SET ECPRCDT=+$GET(ECREC(721,ECIENS,2,"I"))
+9 ;Procedure date
SET ECPROCDT=$$FMTE^XLFDT(ECPRCDT,"5DZ")
+10 ;patient name
SET ECPAT=$EXTRACT($GET(ECREC(721,ECIENS,1,"E")),1,30)
+11 ;ssn
SET ECSSN=$EXTRACT($$GETSSN^ECRDSSA(IEN),1,10)
+12 ;Volume
SET ECVOL=+$GET(ECREC(721,ECIENS,9,"I"))
+13 ;Procedure Code
SET ECPROC=$GET(ECREC(721,ECIENS,8,"I"))
+14 ;proc.code
SET ECPROC=$EXTRACT($$GETPROC^ECRDSSA($GET(ECREC(721,ECIENS,8,"I"))),1,5)
+15 ;Procedure Name
SET ECPROCN=$$GETPRNM^ECRDSSA($GET(ECREC(721,ECIENS,8,"I")),ECPROCDT)
+16 SET ECPROCN=$EXTRACT(ECPROCN,1,25)
+17 ;provider
SET ECPROV=$EXTRACT($$GETPROV^ECRDSSA(IEN),1,30)
+18 SET ECREC=ECPAT_U_ECSSN_U_$$FMTE^XLFDT(ECPRCDT,"2MZ")_U_ECPROC_U_ECPROCN_U_ECVOL_U_ECPROV
+19 SET SRTKEY=$SELECT(SORT="P":ECPAT,1:ECPRCDT)
+20 SET ^TMP($JOB,"ECCLIPRO",ECLOC,ECDSS,SRTKEY,ECPROC,IEN)=ECREC
End DoDot:1
+21 QUIT
+22 ;
PRINT ;loop the temp global and format output
+1 NEW ECSRTBY,ECSKEY,ECREC,ECRDT,ECFDT,ECTDT,ECDAT,ECPRCDT,ECKEY,ECDSS,ECPDSS,ECPROC
+2 NEW CNT,PAGE,LOCNM,LIEN,PROC,PROCDT,CLIEN,CLINM,ECIEN
+3 SET LIEN=ECLOC_","
+4 SET CLIEN=ECCLI_","
+5 SET ECRDT=$$FMTE^XLFDT($$NOW^XLFDT,"5DZ")
+6 SET ECFDT=$$FMTE^XLFDT($PIECE(ECSD+.0001,"."),"5DZ")
+7 SET ECTDT=$$FMTE^XLFDT($PIECE(ECED,"."),"5DZ")
+8 SET ECSRTBY=$SELECT(ECSORT="D":"Procedure Date",1:"Patient Name")
+9 ;Location Name
SET LOCNM=$$GET1^DIQ(4,LIEN,.01)
+10 ;Clinic Name
SET CLINM=$$GET1^DIQ(44,CLIEN,.01)
+11 USE IO
+12 IF '$DATA(^TMP($JOB,"ECCLIPRO"))
Begin DoDot:1
+13 IF ECPTYP'="E"
DO HDR
WRITE !!,?12,"No data to report for the date range selected.",!!
End DoDot:1
QUIT
+14 DO HDR
+15 SET ECDSS=""
SET ECPDSS=""
SET CNT=1
+16 FOR
SET ECDSS=$ORDER(^TMP($JOB,"ECCLIPRO",ECLOC,ECDSS))
if ECDSS=""
QUIT
Begin DoDot:1
+17 IF $Y>(IOSL-8)
DO HDR
+18 IF ECDSS'=ECPDSS
DO DSSHDR(ECDSS)
SET ECPDSS=ECDSS
+19 SET ECSKEY=""
FOR
SET ECSKEY=$ORDER(^TMP($JOB,"ECCLIPRO",ECLOC,ECDSS,ECSKEY))
if ECSKEY=""
QUIT
Begin DoDot:2
+20 SET ECPROC=""
FOR
SET ECPROC=$ORDER(^TMP($JOB,"ECCLIPRO",ECLOC,ECDSS,ECSKEY,ECPROC))
if ECPROC=""
QUIT
Begin DoDot:3
+21 SET ECIEN=""
FOR
SET ECIEN=$ORDER(^TMP($JOB,"ECCLIPRO",ECLOC,ECDSS,ECSKEY,ECPROC,ECIEN))
if ECIEN=""
QUIT
Begin DoDot:4
+22 SET ECREC=^TMP($JOB,"ECCLIPRO",ECLOC,ECDSS,ECSKEY,ECPROC,ECIEN)
+23 ;Exported fields
IF ECPTYP="E"
SET ^TMP($JOB,"ECRPT",CNT+1)=LOCNM_U_$$GETDSSN^ECRDSSA(ECDSS,.ECDSSU)_"(IEN #"_ECDSS_")"_U_CLINM_U_ECREC
SET CNT=CNT+1
QUIT
+24 WRITE !,$PIECE(ECREC,U),?32,$PIECE(ECREC,U,2),?38,$TRANSLATE($PIECE(ECREC,U,3),":"),?53,ECPROC,?59,$PIECE(ECREC,U,5),?88,$JUSTIFY($PIECE(ECREC,U,6),4),?98,$PIECE(ECREC,U,7)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
HDR ; Print the header
+1 if ECPTYP="E"
QUIT
+2 WRITE @IOF
if $GET(PAGE)
WRITE !
+3 SET PAGE=$GET(PAGE)+1
+4 WRITE !?30,"EVENT CAPTURE PROCEDURES BY CLINIC REPORT",?80,"Run Date: ",ECRDT,?122,"Page:",PAGE
+5 WRITE !!,?35,"For Location: ",LOCNM
+6 WRITE !,?35,"Date Range: ",ECFDT," - ",ECTDT
+7 WRITE !,?35,"Clinic: ",CLINM
+8 WRITE !,?35,"Sorted By: ",ECSRTBY
+9 WRITE !!,"Patient",?32,"SSN",?38,"Procedure",?53,"Procedure",?86,"Procedure",?98,"Provider",!
+10 WRITE ?38,"Date/Time",?53,"Code",?59,"Name",?88,"Volume",!
+11 WRITE !,$$REPEAT^XLFSTR("-",132)
+12 QUIT
+13 ;
DSSHDR(ECDSS) ; Print DSS Line
+1 NEW DSSNM
+2 if ECPTYP="E"
QUIT
+3 SET DSSNM=$$GETDSSN^ECRDSSA(ECDSS,.ECDSSU)
+4 IF $Y>(IOSL-8)
DO HDR
+5 DO DSSHDR^ECRDSSA(ECDSS,DSSNM)
+6 WRITE !
+7 QUIT
