- 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 Jan 18, 2025@02:59:53 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