ECRPROC ;ALB/CMD - Event Code Procedure Used Report ;09/24/21 20:47
;;2.0;EVENT CAPTURE;**156,159**;8 May 96;Build 61
;
; Reference to $$CPT^ICPTMOD in ICR #1995
; Reference to ^TMP in SACC 2.3.2.5.1
; Reference to ^%DTC in ICR #10000
; Reference to ^%DT in ICR #10003
;
EN ;Main entry point for report
N %H,ECRDT
S %H=$H D YX^%DTC S ECRDT=Y
K ^TMP("ECRPROC",$J),^TMP("ECTMP",$J),^TMP($J,"ECRPT")
D PROCESS
I ECPTYP="E" D EXPORT K ^TMP("ECRPROC",$J),^TMP("ECTMP",$J) Q
D PRINT K ^TMP("ECRPROC",$J),^TMP("ECTMP",$J)
Q
;
PROCESS ;Get data for the report
N ECFILE,ECDA,ECC,ECCN,ECCPT,ECD,ECPN
N JJ,EC,NLOC,NUNIT,ECDATE,ECP,ECPI,ECPAT,ECPRV,ECPRVN,ECPROVN
N EC725,ECPDX,ECL,ECUNIT,ECV,ECMOD,ECMODF
S ECSD=ECSD-.0001,ECED=ECED+.9999
;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)
K ^TMP("ECRPROC",$J) S ECSD=ECSD-.1,ECED=ECED+.3
F S ECSD=$O(^ECH("AC",ECSD)) Q:'ECSD Q:ECSD>ECED D
. S ECDA="" F S ECDA=$O(^ECH("AC",ECSD,ECDA)) Q:'ECDA D
.. I ECU'="ALL",('$D(^ECH("APRV",ECU,ECDA))) Q
.. S EC=$G(^ECH(ECDA,0)) D
... S ECPRV=$$GETPPRV^ECPRVMUT(ECDA,.ECPRVN),ECPROVN=$S(ECPRV:"UNKNOWN",1:$P(ECPRVN,"^",2))
.. S ECPAT=+$P(EC,"^",2)
.. S ECP=$P(EC,U,9)
.. Q:'$$ECPCHK(ECP,.ECPROC) ;Procedure Code check
.. S ECL=+$P(EC,U,4),ECUNIT=+$P(EC,U,7),ECC=+$P(EC,U,8),ECV=$P(EC,U,10)
.. I '$D(NLOC(ECL))!('$D(NUNIT(ECUNIT))) Q
.. S ECCN=$S($P($G(^EC(726,ECC,0)),"^")]"":$P(^(0),"^"),1:"None")
.. S ECFILE=$P(ECP,";",2),ECFILE=$S($E(ECFILE)="I":81,$E(ECFILE)="E":725,1:"UNKNOWN")
.. S ECCPT=$S(ECFILE=81:+ECP,1:$P($G(^EC(725,+ECP,0)),"^",5)),ECPI=""
.. I ECFILE="UNKNOWN" S ECPN="UNKNOWN"
.. I ECFILE=725 S EC725=$G(^EC(725,+ECP,0)),ECPN=$P(EC725,"^",2)
.. I ECCPT'="" D
... S ECPI=$$CPT^ICPTCOD(ECCPT,$P(ECED,".")),ECCPT=$P(ECPI,U,2)
.. I ECFILE=81 S ECPN=$S($P(ECPI,U,3)]"":$P(ECPI,U,3),1:"UNKNOWN"),ECPDX=ECCPT_"~"_"I"_"~"_ECPN_"~"_ECCPT
.. I ECFILE=725 S EC725=$G(^EC(725,+ECP,0)),ECPDX=$P(EC725,U,2)_"~"_"E"_"~"_$P(EC725,U)_"~"_ECCPT
..;Get Procedure CPT modifiers
.. K ECMOD S ECMODF=0
.. I $O(^ECH(ECDA,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECDA,"I",.ECMOD)
.. D SETTMP ;Set TMP global
Q
;
SETTMP ;Set data into TMP global for print
N MOD,MODSTR
I '$D(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT)) D Q ;New procedure for a patient
. ;Track procedure by Provider
. S $P(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX),U)=$P($G(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX)),U)+1 ;Procedure and Patient count
. S $P(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX),U,2)=$P($G(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX)),U,2)+ECV ;Volume
. ;Add CPT Modifer
. I $D(ECMOD) D
.. S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
... S MODSTR=ECMOD(MOD)
... S MODSTR="- "_$P(MODSTR,U,2)_" "_$P(MODSTR,U,3)
... S ^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX,"MOD",MODSTR)=$G(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX,"MOD",MODSTR))+ECV
. S ^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN)="" ;track Procedure for a patient in ECTMP
.;Set totals for DSS Unit
. S $P(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),0),U)=$P($G(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),0)),U)+1
. S $P(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),0),U,2)=$P(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),0),U,2)+ECV
. S $P(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0),U)=$P($G(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0)),U)+1 ;#Uniques
. S $P(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0),U,2)=$P(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0),U,2)+ECV ;Volume
I $D(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT)) D ;Patient had this procedure
. I '$D(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN)) D ;Diff Prov same Procedure
.. S $P(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX),U)=$P($G(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX)),U)+1 ;Procedure and Patient count
.. S $P(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX),U,2)=$P($G(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX)),U,2)+ECV ;Volume
. ;159 added the next 2 lines.
. I $D(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN)) D ;Same Provider same Procedure - Only update the Volume
.. S $P(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX),U,2)=$P($G(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX)),U,2)+ECV
. ;Add CPT Modifer
. I $D(ECMOD) D
.. S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
... S MODSTR=ECMOD(MOD)
... S MODSTR="- "_$P(MODSTR,U,2)_" "_$P(MODSTR,U,3)
... S ^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX,"MOD",MODSTR)=$G(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX,"MOD",MODSTR))+ECV
. S ^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN)=""
. S $P(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0),U,2)=$P(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0),U,2)+ECV ;only increment volume for the same patient.
. S $P(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),0),U,2)=$P(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),0),U,2)+ECV
Q
;
EXPORT ;Convert data to exportable format
N ECL,ECDSS,ECU,ECCAT,ECPRC,ECCPT,PROVOL,PRVUNIQ,VOL,UNIQUE,PCODE,PCNAM,PCPT,CNT
N ECDUNIT,ECUN,MOD,SUB,MODAMT
K ^TMP($J,"ECRPT")
S CNT=1,^TMP($J,"ECRPT",CNT)="LOCATION^DSS UNIT^CATEGORY^PROVIDER^CPT CODE^CPT MOD #1 (VOL)^CPT MOD #2 (VOL)^CPT MOD #3 (VOL)^PROCEDURE CODE^PROCEDURE NAME^NUMBER UNIQUES^PROCEDURE QUANTITY"
S ECLOC="" F S ECLOC=$O(^TMP("ECRPROC",$J,ECLOC)) Q:ECLOC="" D
.S ECDUNIT="" F S ECDUNIT=$O(^TMP("ECRPROC",$J,ECLOC,ECDUNIT)) Q:ECDUNIT="" D
..S ECUN=0 F S ECUN=$O(^TMP("ECRPROC",$J,ECLOC,ECDUNIT,ECUN)) Q:ECUN="" D
...S ECCAT="" F S ECCAT=$O(^TMP("ECRPROC",$J,ECLOC,ECDUNIT,ECUN,ECCAT)) Q:ECCAT="" D
....S (PROVOL,PRVUNIQ)=0
....S ECPRC="" F S ECPRC=$O(^TMP("ECRPROC",$J,ECLOC,ECDUNIT,ECUN,ECCAT,ECPRC)) Q:ECPRC="" D
.....S DATA=^TMP("ECRPROC",$J,ECLOC,ECDUNIT,ECUN,ECCAT,ECPRC)
.....S UNIQUE=$P(DATA,U),VOL=$P(DATA,U,2)
.....S PROVOL=PROVOL+VOL,PRVUNIQ=PRVUNIQ+UNIQUE
.....S PCODE=$P(ECPRC,"~"),PCNAM=$P(ECPRC,"~",3),PCPT=$P(ECPRC,"~",4)
.....S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=ECLOC_U_ECDUNIT_U_ECCAT_U_$P(ECUN,U,2)_U_PCPT ;_U_PCODE_U_PCNAM_U_PRVUNIQ_U_PROVOL
.....S SUB=0,MODCNT=0 F S:SUB'="" SUB=$O(^TMP("ECRPROC",$J,ECLOC,ECDUNIT,ECUN,ECCAT,ECPRC,"MOD",SUB)) Q:MODCNT=3 D S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_U_MOD,MODCNT=MODCNT+1
......S MOD="" I SUB="" Q
......S MODAMT=^TMP("ECRPROC",$J,ECLOC,ECDUNIT,ECUN,ECCAT,ECPRC,"MOD",SUB)
......S MOD=SUB_"("_MODAMT_")"
.....S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_U_PCODE_U_PCNAM_U_PRVUNIQ_U_PROVOL
Q
;
PRINT ;output report
N ECSD,ECED,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,ECPROVN,ECPRCN,ECCPT,%
N DASH,DATA,PRNTDT,DSSTOT,PAGE,UNIQUES,VOL,Y,PRNDT,PROVOL,PROVUNIQ,PCODE,PCPT,PCNAM,UNIQ
S PAGE=0 S $P(DASH,"-",132)=""
U IO
D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S PRNTDT=Y
S ECSD=$P(ECDATE,"^"),ECED=$P(ECDATE,"^",2)
I '$D(^TMP("ECRPROC",$J)) D HDR W !!,?12,"No data to report for the date range selected.",!! G EXIT
D HDR
S ECLOC="" F S ECLOC=$O(^TMP("ECRPROC",$J,ECLOC)) Q:ECLOC="" D
. W !!,"Location: "_ECLOC
. S ECUNIT="" F S ECUNIT=$O(^TMP("ECRPROC",$J,ECLOC,ECUNIT)) Q:ECUNIT="" D
.. W !,"DSS Unit: "_ECUNIT
.. S DSSTOT=^TMP("ECRPROC",$J,ECLOC,ECUNIT,0)
.. S ECPROV="" F S ECPROV=$O(^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV)) Q:ECPROV="" D
... S (PROVOL,PROVUNIQ)=0
... S ECCAT="" F S ECCAT=$O(^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT)) Q:ECCAT="" D
.... S ECPROVN=$P(ECPROV,U,2)
.... W !!,ECPROVN,!,?3,ECCAT,!
.... S ECPRC="" F S ECPRC=$O(^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC)) Q:ECPRC="" D
..... S DATA=^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC)
..... S VOL=$P(DATA,U,2),UNIQ=$P(DATA,U)
..... S PCODE=$P(ECPRC,"~"),PCNAM=$P(ECPRC,"~",3),PCPT=$P(ECPRC,"~",4)
..... S ECCPT=$P(ECPRC,"~",4),ECPRCN=$P(ECPRC,"~",3)
..... S PROVOL=PROVOL+VOL,PROVUNIQ=PROVUNIQ+UNIQ
..... W !,?6,$J(PCPT_" ",6),$J(PCODE_" ",6),?18,$E(PCNAM,1,40),?70,$J(UNIQ,6),?95,$J(VOL,6)
..... D PRTMOD ;PRint CPT Modifier
..... I ($Y+6)>IOSL D PAGE
.... D TOTPRV
.. D TOTDSS,FOOTER
Q
;
PAGE ; end of page
D:$D(PAGE) FOOTER
Q
;
TOTPRV ; Total line for Provider
W !,?70,"--------",?95,"--------",!,"Totals for ",ECPROVN,?70,$J(PROVUNIQ,6),?95,$J(PROVOL,6),!
Q
TOTDSS ; Total line for DSS UNIT
W !!,?70,"--------",?95,"--------",!,?70,"--------",?95,"--------"
W !,"Grand Totals for ",ECUNIT,?70,$J($P(DSSTOT,U),6),?95,$J($P(DSSTOT,U,2),6)
W !
Q
HDR ; print heading
W @IOF W:$G(PAGE) !
S PAGE=$G(PAGE)+1
W:$Y @IOF W !?49,"EVENT CAPTURE PROCEDURE SUMMARY REPORT",?122,"Page:",PAGE,!,?49,"FROM "_$P(ECDATE,"^")_" TO "_$P(ECDATE,"^",2),!,?49,"Run Date : ",ECRDT
W !!?3,"Category",!,?6,"CPT",?12,"Proc",?18,"Procedure Name" ;112
W ?70,"# UNIQUES",?95,"Volume*"
W !?6,"Code",?12,"Code",!?10,"CPT Modifier (volume)",!
W DASH
I '$D(^TMP("ECRPROC",$J)) Q
;W !!,"Location: "_ECLOC,!,"DSS Unit: "_ECUNIT
Q
;
W !!?4,"*Volume totals may represent days, minutes, numbers of procedures"
W " and/or a combination of these."
W !?4,"UNIQUES totals may present the number of times a provider has used the given procedure code on a patient"
W !?4,"during the selected time period. The Grand Total number of UNIQUES may not equal the sum of UNIQUES, as a "
W !?4,"patient may have been seen by more than one Provider."
Q
;
PRTMOD ;Print CPT Modifier
N CPTMOD,MODSTR
I $O(^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,"MOD",""))="" Q
S MODSTR=""
F S MODSTR=$O(^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,"MOD",MODSTR)) Q:MODSTR="" D
. W !?10,MODSTR_" ("_^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,"MOD",MODSTR)_")"
. I ($Y+6)>IOSL D PAGE
Q
;
ECPCHK(PROC,ECPROC) ;Procedure Code check
N PRO,PX
I PROC["EC" D
.S PROC=$G(^EC(725,$P(PROC,";"),0)),PX=$P(PROC,U,2)_"~"_$P(PROC,U)
E S PROC=$$CPT^ICPTCOD($P(PROC,";")) S PX=$P(PROC,U,2)_"~"_$P(PROC,U,3)
I '$D(ECPROC($P(PX,"~"))) Q 0
Q 1
;
EXIT ;common exit point
K ^TMP("ECRPROC",$J),^TMP("ECTMP",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRPROC 10503 printed Oct 16, 2024@17:59:24 Page 2
ECRPROC ;ALB/CMD - Event Code Procedure Used Report ;09/24/21 20:47
+1 ;;2.0;EVENT CAPTURE;**156,159**;8 May 96;Build 61
+2 ;
+3 ; Reference to $$CPT^ICPTMOD in ICR #1995
+4 ; Reference to ^TMP in SACC 2.3.2.5.1
+5 ; Reference to ^%DTC in ICR #10000
+6 ; Reference to ^%DT in ICR #10003
+7 ;
EN ;Main entry point for report
+1 NEW %H,ECRDT
+2 SET %H=$HOROLOG
DO YX^%DTC
SET ECRDT=Y
+3 KILL ^TMP("ECRPROC",$JOB),^TMP("ECTMP",$JOB),^TMP($JOB,"ECRPT")
+4 DO PROCESS
+5 IF ECPTYP="E"
DO EXPORT
KILL ^TMP("ECRPROC",$JOB),^TMP("ECTMP",$JOB)
QUIT
+6 DO PRINT
KILL ^TMP("ECRPROC",$JOB),^TMP("ECTMP",$JOB)
+7 QUIT
+8 ;
PROCESS ;Get data for the report
+1 NEW ECFILE,ECDA,ECC,ECCN,ECCPT,ECD,ECPN
+2 NEW JJ,EC,NLOC,NUNIT,ECDATE,ECP,ECPI,ECPAT,ECPRV,ECPRVN,ECPROVN
+3 NEW EC725,ECPDX,ECL,ECUNIT,ECV,ECMOD,ECMODF
+4 SET ECSD=ECSD-.0001
SET ECED=ECED+.9999
+5 ;put locations and units into ien subscripted arrays
+6 SET JJ=""
FOR
SET JJ=$ORDER(ECLOC(JJ))
if JJ=""
QUIT
Begin DoDot:1
+7 SET NLOC($PIECE(ECLOC(JJ),"^",1))=$PIECE(ECLOC(JJ),"^",2)
End DoDot:1
+8 SET JJ=""
FOR
SET JJ=$ORDER(ECDSSU(JJ))
if JJ=""
QUIT
Begin DoDot:1
+9 SET NUNIT($PIECE(ECDSSU(JJ),"^",1))=$PIECE(ECDSSU(JJ),"^",2)
End DoDot:1
+10 KILL ^TMP("ECRPROC",$JOB)
SET ECSD=ECSD-.1
SET ECED=ECED+.3
+11 FOR
SET ECSD=$ORDER(^ECH("AC",ECSD))
if 'ECSD
QUIT
if ECSD>ECED
QUIT
Begin DoDot:1
+12 SET ECDA=""
FOR
SET ECDA=$ORDER(^ECH("AC",ECSD,ECDA))
if 'ECDA
QUIT
Begin DoDot:2
+13 IF ECU'="ALL"
IF ('$DATA(^ECH("APRV",ECU,ECDA)))
QUIT
+14 SET EC=$GET(^ECH(ECDA,0))
Begin DoDot:3
+15 SET ECPRV=$$GETPPRV^ECPRVMUT(ECDA,.ECPRVN)
SET ECPROVN=$SELECT(ECPRV:"UNKNOWN",1:$PIECE(ECPRVN,"^",2))
End DoDot:3
+16 SET ECPAT=+$PIECE(EC,"^",2)
+17 SET ECP=$PIECE(EC,U,9)
+18 ;Procedure Code check
if '$$ECPCHK(ECP,.ECPROC)
QUIT
+19 SET ECL=+$PIECE(EC,U,4)
SET ECUNIT=+$PIECE(EC,U,7)
SET ECC=+$PIECE(EC,U,8)
SET ECV=$PIECE(EC,U,10)
+20 IF '$DATA(NLOC(ECL))!('$DATA(NUNIT(ECUNIT)))
QUIT
+21 SET ECCN=$SELECT($PIECE($GET(^EC(726,ECC,0)),"^")]"":$PIECE(^(0),"^"),1:"None")
+22 SET ECFILE=$PIECE(ECP,";",2)
SET ECFILE=$SELECT($EXTRACT(ECFILE)="I":81,$EXTRACT(ECFILE)="E":725,1:"UNKNOWN")
+23 SET ECCPT=$SELECT(ECFILE=81:+ECP,1:$PIECE($GET(^EC(725,+ECP,0)),"^",5))
SET ECPI=""
+24 IF ECFILE="UNKNOWN"
SET ECPN="UNKNOWN"
+25 IF ECFILE=725
SET EC725=$GET(^EC(725,+ECP,0))
SET ECPN=$PIECE(EC725,"^",2)
+26 IF ECCPT'=""
Begin DoDot:3
+27 SET ECPI=$$CPT^ICPTCOD(ECCPT,$PIECE(ECED,"."))
SET ECCPT=$PIECE(ECPI,U,2)
End DoDot:3
+28 IF ECFILE=81
SET ECPN=$SELECT($PIECE(ECPI,U,3)]"":$PIECE(ECPI,U,3),1:"UNKNOWN")
SET ECPDX=ECCPT_"~"_"I"_"~"_ECPN_"~"_ECCPT
+29 IF ECFILE=725
SET EC725=$GET(^EC(725,+ECP,0))
SET ECPDX=$PIECE(EC725,U,2)_"~"_"E"_"~"_$PIECE(EC725,U)_"~"_ECCPT
+30 ;Get Procedure CPT modifiers
+31 KILL ECMOD
SET ECMODF=0
+32 IF $ORDER(^ECH(ECDA,"MOD",0))'=""
SET ECMODF=$$MOD^ECUTL(ECDA,"I",.ECMOD)
+33 ;Set TMP global
DO SETTMP
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
SETTMP ;Set data into TMP global for print
+1 NEW MOD,MODSTR
+2 ;New procedure for a patient
IF '$DATA(^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT))
Begin DoDot:1
+3 ;Track procedure by Provider
+4 ;Procedure and Patient count
SET $PIECE(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX),U)=$PIECE($GET(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX)),U)+1
+5 ;Volume
SET $PIECE(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX),U,2)=$PIECE($GET(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX)),U,2)+ECV
+6 ;Add CPT Modifer
+7 IF $DATA(ECMOD)
Begin DoDot:2
+8 SET MOD=""
FOR
SET MOD=$ORDER(ECMOD(MOD))
if MOD=""
QUIT
Begin DoDot:3
+9 SET MODSTR=ECMOD(MOD)
+10 SET MODSTR="- "_$PIECE(MODSTR,U,2)_" "_$PIECE(MODSTR,U,3)
+11 SET ^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX,"MOD",MODSTR)=$GET(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX,"MOD",MODSTR))+ECV
End DoDot:3
End DoDot:2
+12 ;track Procedure for a patient in ECTMP
SET ^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN)=""
+13 ;Set totals for DSS Unit
+14 SET $PIECE(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),0),U)=$PIECE($GET(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),0)),U)+1
+15 SET $PIECE(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),0),U,2)=$PIECE(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),0),U,2)+ECV
+16 ;#Uniques
SET $PIECE(^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0),U)=$PIECE($GET(^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0)),U)+1
+17 ;Volume
SET $PIECE(^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0),U,2)=$PIECE(^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0),U,2)+ECV
End DoDot:1
QUIT
+18 ;Patient had this procedure
IF $DATA(^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT))
Begin DoDot:1
+19 ;Diff Prov same Procedure
IF '$DATA(^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN))
Begin DoDot:2
+20 ;Procedure and Patient count
SET $PIECE(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX),U)=$PIECE($GET(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX)),U)+1
+21 ;Volume
SET $PIECE(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX),U,2)=$PIECE($GET(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX)),U,2)+ECV
End DoDot:2
+22 ;159 added the next 2 lines.
+23 ;Same Provider same Procedure - Only update the Volume
IF $DATA(^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN))
Begin DoDot:2
+24 SET $PIECE(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX),U,2)=$PIECE($GET(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX)),U,2)+ECV
End DoDot:2
+25 ;Add CPT Modifer
+26 IF $DATA(ECMOD)
Begin DoDot:2
+27 SET MOD=""
FOR
SET MOD=$ORDER(ECMOD(MOD))
if MOD=""
QUIT
Begin DoDot:3
+28 SET MODSTR=ECMOD(MOD)
+29 SET MODSTR="- "_$PIECE(MODSTR,U,2)_" "_$PIECE(MODSTR,U,3)
+30 SET ^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX,"MOD",MODSTR)=$GET(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPRVN,ECCN,ECPDX,"MOD",MODSTR))+ECV
End DoDot:3
End DoDot:2
+31 SET ^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN)=""
+32 ;only increment volume for the same patient.
SET $PIECE(^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0),U,2)=$PIECE(^TMP("ECTMP",$JOB,NLOC(ECL),NUNIT(ECUNIT),ECPDX,0),U,2)+ECV
+33 SET $PIECE(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),0),U,2)=$PIECE(^TMP("ECRPROC",$JOB,NLOC(ECL),NUNIT(ECUNIT),0),U,2)+ECV
End DoDot:1
+34 QUIT
+35 ;
EXPORT ;Convert data to exportable format
+1 NEW ECL,ECDSS,ECU,ECCAT,ECPRC,ECCPT,PROVOL,PRVUNIQ,VOL,UNIQUE,PCODE,PCNAM,PCPT,CNT
+2 NEW ECDUNIT,ECUN,MOD,SUB,MODAMT
+3 KILL ^TMP($JOB,"ECRPT")
+4 SET CNT=1
SET ^TMP($JOB,"ECRPT",CNT)="LOCATION^DSS UNIT^CATEGORY^PROVIDER^CPT CODE^CPT MOD #1 (VOL)^CPT MOD #2 (VOL)^CPT MOD #3 (VOL)^PROCEDURE CODE^PROCEDURE NAME^NUMBER UNIQUES^PROCEDURE QUANTITY"
+5 SET ECLOC=""
FOR
SET ECLOC=$ORDER(^TMP("ECRPROC",$JOB,ECLOC))
if ECLOC=""
QUIT
Begin DoDot:1
+6 SET ECDUNIT=""
FOR
SET ECDUNIT=$ORDER(^TMP("ECRPROC",$JOB,ECLOC,ECDUNIT))
if ECDUNIT=""
QUIT
Begin DoDot:2
+7 SET ECUN=0
FOR
SET ECUN=$ORDER(^TMP("ECRPROC",$JOB,ECLOC,ECDUNIT,ECUN))
if ECUN=""
QUIT
Begin DoDot:3
+8 SET ECCAT=""
FOR
SET ECCAT=$ORDER(^TMP("ECRPROC",$JOB,ECLOC,ECDUNIT,ECUN,ECCAT))
if ECCAT=""
QUIT
Begin DoDot:4
+9 SET (PROVOL,PRVUNIQ)=0
+10 SET ECPRC=""
FOR
SET ECPRC=$ORDER(^TMP("ECRPROC",$JOB,ECLOC,ECDUNIT,ECUN,ECCAT,ECPRC))
if ECPRC=""
QUIT
Begin DoDot:5
+11 SET DATA=^TMP("ECRPROC",$JOB,ECLOC,ECDUNIT,ECUN,ECCAT,ECPRC)
+12 SET UNIQUE=$PIECE(DATA,U)
SET VOL=$PIECE(DATA,U,2)
+13 SET PROVOL=PROVOL+VOL
SET PRVUNIQ=PRVUNIQ+UNIQUE
+14 SET PCODE=$PIECE(ECPRC,"~")
SET PCNAM=$PIECE(ECPRC,"~",3)
SET PCPT=$PIECE(ECPRC,"~",4)
+15 ;_U_PCODE_U_PCNAM_U_PRVUNIQ_U_PROVOL
SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=ECLOC_U_ECDUNIT_U_ECCAT_U_$PIECE(ECUN,U,2)_U_PCPT
+16 SET SUB=0
SET MODCNT=0
FOR
if SUB'=""
SET SUB=$ORDER(^TMP("ECRPROC",$JOB,ECLOC,ECDUNIT,ECUN,ECCAT,ECPRC,"MOD",SUB))
if MODCNT=3
QUIT
Begin DoDot:6
+17 SET MOD=""
IF SUB=""
QUIT
+18 SET MODAMT=^TMP("ECRPROC",$JOB,ECLOC,ECDUNIT,ECUN,ECCAT,ECPRC,"MOD",SUB)
+19 SET MOD=SUB_"("_MODAMT_")"
End DoDot:6
SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_U_MOD
SET MODCNT=MODCNT+1
+20 SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_U_PCODE_U_PCNAM_U_PRVUNIQ_U_PROVOL
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
PRINT ;output report
+1 NEW ECSD,ECED,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,ECPROVN,ECPRCN,ECCPT,%
+2 NEW DASH,DATA,PRNTDT,DSSTOT,PAGE,UNIQUES,VOL,Y,PRNDT,PROVOL,PROVUNIQ,PCODE,PCPT,PCNAM,UNIQ
+3 SET PAGE=0
SET $PIECE(DASH,"-",132)=""
+4 USE IO
+5 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET PRNTDT=Y
+6 SET ECSD=$PIECE(ECDATE,"^")
SET ECED=$PIECE(ECDATE,"^",2)
+7 IF '$DATA(^TMP("ECRPROC",$JOB))
DO HDR
WRITE !!,?12,"No data to report for the date range selected.",!!
GOTO EXIT
+8 DO HDR
+9 SET ECLOC=""
FOR
SET ECLOC=$ORDER(^TMP("ECRPROC",$JOB,ECLOC))
if ECLOC=""
QUIT
Begin DoDot:1
+10 WRITE !!,"Location: "_ECLOC
+11 SET ECUNIT=""
FOR
SET ECUNIT=$ORDER(^TMP("ECRPROC",$JOB,ECLOC,ECUNIT))
if ECUNIT=""
QUIT
Begin DoDot:2
+12 WRITE !,"DSS Unit: "_ECUNIT
+13 SET DSSTOT=^TMP("ECRPROC",$JOB,ECLOC,ECUNIT,0)
+14 SET ECPROV=""
FOR
SET ECPROV=$ORDER(^TMP("ECRPROC",$JOB,ECLOC,ECUNIT,ECPROV))
if ECPROV=""
QUIT
Begin DoDot:3
+15 SET (PROVOL,PROVUNIQ)=0
+16 SET ECCAT=""
FOR
SET ECCAT=$ORDER(^TMP("ECRPROC",$JOB,ECLOC,ECUNIT,ECPROV,ECCAT))
if ECCAT=""
QUIT
Begin DoDot:4
+17 SET ECPROVN=$PIECE(ECPROV,U,2)
+18 WRITE !!,ECPROVN,!,?3,ECCAT,!
+19 SET ECPRC=""
FOR
SET ECPRC=$ORDER(^TMP("ECRPROC",$JOB,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC))
if ECPRC=""
QUIT
Begin DoDot:5
+20 SET DATA=^TMP("ECRPROC",$JOB,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC)
+21 SET VOL=$PIECE(DATA,U,2)
SET UNIQ=$PIECE(DATA,U)
+22 SET PCODE=$PIECE(ECPRC,"~")
SET PCNAM=$PIECE(ECPRC,"~",3)
SET PCPT=$PIECE(ECPRC,"~",4)
+23 SET ECCPT=$PIECE(ECPRC,"~",4)
SET ECPRCN=$PIECE(ECPRC,"~",3)
+24 SET PROVOL=PROVOL+VOL
SET PROVUNIQ=PROVUNIQ+UNIQ
+25 WRITE !,?6,$JUSTIFY(PCPT_" ",6),$JUSTIFY(PCODE_" ",6),?18,$EXTRACT(PCNAM,1,40),?70,$JUSTIFY(UNIQ,6),?95,$JUSTIFY(VOL,6)
+26 ;PRint CPT Modifier
DO PRTMOD
+27 IF ($Y+6)>IOSL
DO PAGE
End DoDot:5
+28 DO TOTPRV
End DoDot:4
End DoDot:3
+29 DO TOTDSS
DO FOOTER
End DoDot:2
End DoDot:1
+30 QUIT
+31 ;
PAGE ; end of page
+1 if $DATA(PAGE)
DO FOOTER
+2 QUIT
+3 ;
TOTPRV ; Total line for Provider
+1 WRITE !,?70,"--------",?95,"--------",!,"Totals for ",ECPROVN,?70,$JUSTIFY(PROVUNIQ,6),?95,$JUSTIFY(PROVOL,6),!
+2 QUIT
TOTDSS ; Total line for DSS UNIT
+1 WRITE !!,?70,"--------",?95,"--------",!,?70,"--------",?95,"--------"
+2 WRITE !,"Grand Totals for ",ECUNIT,?70,$JUSTIFY($PIECE(DSSTOT,U),6),?95,$JUSTIFY($PIECE(DSSTOT,U,2),6)
+3 WRITE !
+4 QUIT
HDR ; print heading
+1 WRITE @IOF
if $GET(PAGE)
WRITE !
+2 SET PAGE=$GET(PAGE)+1
+3 if $Y
WRITE @IOF
WRITE !?49,"EVENT CAPTURE PROCEDURE SUMMARY REPORT",?122,"Page:",PAGE,!,?49,"FROM "_$PIECE(ECDATE,"^")_" TO "_$PIECE(ECDATE,"^",2),!,?49,"Run Date : ",ECRDT
+4 ;112
WRITE !!?3,"Category",!,?6,"CPT",?12,"Proc",?18,"Procedure Name"
+5 WRITE ?70,"# UNIQUES",?95,"Volume*"
+6 WRITE !?6,"Code",?12,"Code",!?10,"CPT Modifier (volume)",!
+7 WRITE DASH
+8 IF '$DATA(^TMP("ECRPROC",$JOB))
QUIT
+9 ;W !!,"Location: "_ECLOC,!,"DSS Unit: "_ECUNIT
+10 QUIT
+11 ;
+1 WRITE !!?4,"*Volume totals may represent days, minutes, numbers of procedures"
+2 WRITE " and/or a combination of these."
+3 WRITE !?4,"UNIQUES totals may present the number of times a provider has used the given procedure code on a patient"
+4 WRITE !?4,"during the selected time period. The Grand Total number of UNIQUES may not equal the sum of UNIQUES, as a "
+5 WRITE !?4,"patient may have been seen by more than one Provider."
+6 QUIT
+7 ;
PRTMOD ;Print CPT Modifier
+1 NEW CPTMOD,MODSTR
+2 IF $ORDER(^TMP("ECRPROC",$JOB,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,"MOD",""))=""
QUIT
+3 SET MODSTR=""
+4 FOR
SET MODSTR=$ORDER(^TMP("ECRPROC",$JOB,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,"MOD",MODSTR))
if MODSTR=""
QUIT
Begin DoDot:1
+5 WRITE !?10,MODSTR_" ("_^TMP("ECRPROC",$JOB,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,"MOD",MODSTR)_")"
+6 IF ($Y+6)>IOSL
DO PAGE
End DoDot:1
+7 QUIT
+8 ;
ECPCHK(PROC,ECPROC) ;Procedure Code check
+1 NEW PRO,PX
+2 IF PROC["EC"
Begin DoDot:1
+3 SET PROC=$GET(^EC(725,$PIECE(PROC,";"),0))
SET PX=$PIECE(PROC,U,2)_"~"_$PIECE(PROC,U)
End DoDot:1
+4 IF '$TEST
SET PROC=$$CPT^ICPTCOD($PIECE(PROC,";"))
SET PX=$PIECE(PROC,U,2)_"~"_$PIECE(PROC,U,3)
+5 IF '$DATA(ECPROC($PIECE(PX,"~")))
QUIT 0
+6 QUIT 1
+7 ;
EXIT ;common exit point
+1 KILL ^TMP("ECRPROC",$JOB),^TMP("ECTMP",$JOB)
+2 QUIT
