Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECRPROC

ECRPROC.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference to $$CPT^ICPTMOD in ICR #1995
  1. ; Reference to ^TMP in SACC 2.3.2.5.1
  1. ; Reference to ^%DTC in ICR #10000
  1. ; Reference to ^%DT in ICR #10003
  1. ;
  1. EN ;Main entry point for report
  1. N %H,ECRDT
  1. S %H=$H D YX^%DTC S ECRDT=Y
  1. K ^TMP("ECRPROC",$J),^TMP("ECTMP",$J),^TMP($J,"ECRPT")
  1. D PROCESS
  1. I ECPTYP="E" D EXPORT K ^TMP("ECRPROC",$J),^TMP("ECTMP",$J) Q
  1. D PRINT K ^TMP("ECRPROC",$J),^TMP("ECTMP",$J)
  1. Q
  1. ;
  1. PROCESS ;Get data for the report
  1. N ECFILE,ECDA,ECC,ECCN,ECCPT,ECD,ECPN
  1. N JJ,EC,NLOC,NUNIT,ECDATE,ECP,ECPI,ECPAT,ECPRV,ECPRVN,ECPROVN
  1. N EC725,ECPDX,ECL,ECUNIT,ECV,ECMOD,ECMODF
  1. S ECSD=ECSD-.0001,ECED=ECED+.9999
  1. ;put locations and units into ien subscripted arrays
  1. S JJ="" F S JJ=$O(ECLOC(JJ)) Q:JJ="" D
  1. .S NLOC($P(ECLOC(JJ),"^",1))=$P(ECLOC(JJ),"^",2)
  1. S JJ="" F S JJ=$O(ECDSSU(JJ)) Q:JJ="" D
  1. .S NUNIT($P(ECDSSU(JJ),"^",1))=$P(ECDSSU(JJ),"^",2)
  1. K ^TMP("ECRPROC",$J) S ECSD=ECSD-.1,ECED=ECED+.3
  1. F S ECSD=$O(^ECH("AC",ECSD)) Q:'ECSD Q:ECSD>ECED D
  1. . S ECDA="" F S ECDA=$O(^ECH("AC",ECSD,ECDA)) Q:'ECDA D
  1. .. I ECU'="ALL",('$D(^ECH("APRV",ECU,ECDA))) Q
  1. .. S EC=$G(^ECH(ECDA,0)) D
  1. ... S ECPRV=$$GETPPRV^ECPRVMUT(ECDA,.ECPRVN),ECPROVN=$S(ECPRV:"UNKNOWN",1:$P(ECPRVN,"^",2))
  1. .. S ECPAT=+$P(EC,"^",2)
  1. .. S ECP=$P(EC,U,9)
  1. .. Q:'$$ECPCHK(ECP,.ECPROC) ;Procedure Code check
  1. .. S ECL=+$P(EC,U,4),ECUNIT=+$P(EC,U,7),ECC=+$P(EC,U,8),ECV=$P(EC,U,10)
  1. .. I '$D(NLOC(ECL))!('$D(NUNIT(ECUNIT))) Q
  1. .. S ECCN=$S($P($G(^EC(726,ECC,0)),"^")]"":$P(^(0),"^"),1:"None")
  1. .. S ECFILE=$P(ECP,";",2),ECFILE=$S($E(ECFILE)="I":81,$E(ECFILE)="E":725,1:"UNKNOWN")
  1. .. S ECCPT=$S(ECFILE=81:+ECP,1:$P($G(^EC(725,+ECP,0)),"^",5)),ECPI=""
  1. .. I ECFILE="UNKNOWN" S ECPN="UNKNOWN"
  1. .. I ECFILE=725 S EC725=$G(^EC(725,+ECP,0)),ECPN=$P(EC725,"^",2)
  1. .. I ECCPT'="" D
  1. ... S ECPI=$$CPT^ICPTCOD(ECCPT,$P(ECED,".")),ECCPT=$P(ECPI,U,2)
  1. .. I ECFILE=81 S ECPN=$S($P(ECPI,U,3)]"":$P(ECPI,U,3),1:"UNKNOWN"),ECPDX=ECCPT_"~"_"I"_"~"_ECPN_"~"_ECCPT
  1. .. I ECFILE=725 S EC725=$G(^EC(725,+ECP,0)),ECPDX=$P(EC725,U,2)_"~"_"E"_"~"_$P(EC725,U)_"~"_ECCPT
  1. ..;Get Procedure CPT modifiers
  1. .. K ECMOD S ECMODF=0
  1. .. I $O(^ECH(ECDA,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECDA,"I",.ECMOD)
  1. .. D SETTMP ;Set TMP global
  1. Q
  1. ;
  1. SETTMP ;Set data into TMP global for print
  1. N MOD,MODSTR
  1. I '$D(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT)) D Q ;New procedure for a patient
  1. . ;Track procedure by Provider
  1. . 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
  1. . 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
  1. . ;Add CPT Modifer
  1. . I $D(ECMOD) D
  1. .. S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
  1. ... S MODSTR=ECMOD(MOD)
  1. ... S MODSTR="- "_$P(MODSTR,U,2)_" "_$P(MODSTR,U,3)
  1. ... 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
  1. . S ^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN)="" ;track Procedure for a patient in ECTMP
  1. .;Set totals for DSS Unit
  1. . S $P(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),0),U)=$P($G(^TMP("ECRPROC",$J,NLOC(ECL),NUNIT(ECUNIT),0)),U)+1
  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
  1. . 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
  1. . 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
  1. I $D(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT)) D ;Patient had this procedure
  1. . I '$D(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN)) D ;Diff Prov same Procedure
  1. .. 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
  1. .. 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
  1. . ;159 added the next 2 lines.
  1. . I $D(^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN)) D ;Same Provider same Procedure - Only update the Volume
  1. .. 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
  1. . ;Add CPT Modifer
  1. . I $D(ECMOD) D
  1. .. S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
  1. ... S MODSTR=ECMOD(MOD)
  1. ... S MODSTR="- "_$P(MODSTR,U,2)_" "_$P(MODSTR,U,3)
  1. ... 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
  1. . S ^TMP("ECTMP",$J,NLOC(ECL),NUNIT(ECUNIT),ECPDX,ECPAT,ECPRVN)=""
  1. . 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.
  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
  1. Q
  1. ;
  1. EXPORT ;Convert data to exportable format
  1. N ECL,ECDSS,ECU,ECCAT,ECPRC,ECCPT,PROVOL,PRVUNIQ,VOL,UNIQUE,PCODE,PCNAM,PCPT,CNT
  1. N ECDUNIT,ECUN,MOD,SUB,MODAMT
  1. K ^TMP($J,"ECRPT")
  1. 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"
  1. S ECLOC="" F S ECLOC=$O(^TMP("ECRPROC",$J,ECLOC)) Q:ECLOC="" D
  1. .S ECDUNIT="" F S ECDUNIT=$O(^TMP("ECRPROC",$J,ECLOC,ECDUNIT)) Q:ECDUNIT="" D
  1. ..S ECUN=0 F S ECUN=$O(^TMP("ECRPROC",$J,ECLOC,ECDUNIT,ECUN)) Q:ECUN="" D
  1. ...S ECCAT="" F S ECCAT=$O(^TMP("ECRPROC",$J,ECLOC,ECDUNIT,ECUN,ECCAT)) Q:ECCAT="" D
  1. ....S (PROVOL,PRVUNIQ)=0
  1. ....S ECPRC="" F S ECPRC=$O(^TMP("ECRPROC",$J,ECLOC,ECDUNIT,ECUN,ECCAT,ECPRC)) Q:ECPRC="" D
  1. .....S DATA=^TMP("ECRPROC",$J,ECLOC,ECDUNIT,ECUN,ECCAT,ECPRC)
  1. .....S UNIQUE=$P(DATA,U),VOL=$P(DATA,U,2)
  1. .....S PROVOL=PROVOL+VOL,PRVUNIQ=PRVUNIQ+UNIQUE
  1. .....S PCODE=$P(ECPRC,"~"),PCNAM=$P(ECPRC,"~",3),PCPT=$P(ECPRC,"~",4)
  1. .....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
  1. .....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
  1. ......S MOD="" I SUB="" Q
  1. ......S MODAMT=^TMP("ECRPROC",$J,ECLOC,ECDUNIT,ECUN,ECCAT,ECPRC,"MOD",SUB)
  1. ......S MOD=SUB_"("_MODAMT_")"
  1. .....S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_U_PCODE_U_PCNAM_U_PRVUNIQ_U_PROVOL
  1. Q
  1. ;
  1. PRINT ;output report
  1. N ECSD,ECED,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,ECPROVN,ECPRCN,ECCPT,%
  1. N DASH,DATA,PRNTDT,DSSTOT,PAGE,UNIQUES,VOL,Y,PRNDT,PROVOL,PROVUNIQ,PCODE,PCPT,PCNAM,UNIQ
  1. S PAGE=0 S $P(DASH,"-",132)=""
  1. U IO
  1. D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S PRNTDT=Y
  1. S ECSD=$P(ECDATE,"^"),ECED=$P(ECDATE,"^",2)
  1. I '$D(^TMP("ECRPROC",$J)) D HDR W !!,?12,"No data to report for the date range selected.",!! G EXIT
  1. D HDR
  1. S ECLOC="" F S ECLOC=$O(^TMP("ECRPROC",$J,ECLOC)) Q:ECLOC="" D
  1. . W !!,"Location: "_ECLOC
  1. . S ECUNIT="" F S ECUNIT=$O(^TMP("ECRPROC",$J,ECLOC,ECUNIT)) Q:ECUNIT="" D
  1. .. W !,"DSS Unit: "_ECUNIT
  1. .. S DSSTOT=^TMP("ECRPROC",$J,ECLOC,ECUNIT,0)
  1. .. S ECPROV="" F S ECPROV=$O(^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV)) Q:ECPROV="" D
  1. ... S (PROVOL,PROVUNIQ)=0
  1. ... S ECCAT="" F S ECCAT=$O(^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT)) Q:ECCAT="" D
  1. .... S ECPROVN=$P(ECPROV,U,2)
  1. .... W !!,ECPROVN,!,?3,ECCAT,!
  1. .... S ECPRC="" F S ECPRC=$O(^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC)) Q:ECPRC="" D
  1. ..... S DATA=^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC)
  1. ..... S VOL=$P(DATA,U,2),UNIQ=$P(DATA,U)
  1. ..... S PCODE=$P(ECPRC,"~"),PCNAM=$P(ECPRC,"~",3),PCPT=$P(ECPRC,"~",4)
  1. ..... S ECCPT=$P(ECPRC,"~",4),ECPRCN=$P(ECPRC,"~",3)
  1. ..... S PROVOL=PROVOL+VOL,PROVUNIQ=PROVUNIQ+UNIQ
  1. ..... W !,?6,$J(PCPT_" ",6),$J(PCODE_" ",6),?18,$E(PCNAM,1,40),?70,$J(UNIQ,6),?95,$J(VOL,6)
  1. ..... D PRTMOD ;PRint CPT Modifier
  1. ..... I ($Y+6)>IOSL D PAGE
  1. .... D TOTPRV
  1. .. D TOTDSS,FOOTER
  1. Q
  1. ;
  1. PAGE ; end of page
  1. D:$D(PAGE) FOOTER
  1. Q
  1. ;
  1. TOTPRV ; Total line for Provider
  1. W !,?70,"--------",?95,"--------",!,"Totals for ",ECPROVN,?70,$J(PROVUNIQ,6),?95,$J(PROVOL,6),!
  1. Q
  1. TOTDSS ; Total line for DSS UNIT
  1. W !!,?70,"--------",?95,"--------",!,?70,"--------",?95,"--------"
  1. W !,"Grand Totals for ",ECUNIT,?70,$J($P(DSSTOT,U),6),?95,$J($P(DSSTOT,U,2),6)
  1. W !
  1. Q
  1. HDR ; print heading
  1. W @IOF W:$G(PAGE) !
  1. S PAGE=$G(PAGE)+1
  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
  1. W !!?3,"Category",!,?6,"CPT",?12,"Proc",?18,"Procedure Name" ;112
  1. W ?70,"# UNIQUES",?95,"Volume*"
  1. W !?6,"Code",?12,"Code",!?10,"CPT Modifier (volume)",!
  1. W DASH
  1. I '$D(^TMP("ECRPROC",$J)) Q
  1. ;W !!,"Location: "_ECLOC,!,"DSS Unit: "_ECUNIT
  1. Q
  1. ;
  1. W !!?4,"*Volume totals may represent days, minutes, numbers of procedures"
  1. W " and/or a combination of these."
  1. W !?4,"UNIQUES totals may present the number of times a provider has used the given procedure code on a patient"
  1. W !?4,"during the selected time period. The Grand Total number of UNIQUES may not equal the sum of UNIQUES, as a "
  1. W !?4,"patient may have been seen by more than one Provider."
  1. Q
  1. ;
  1. PRTMOD ;Print CPT Modifier
  1. N CPTMOD,MODSTR
  1. I $O(^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,"MOD",""))="" Q
  1. S MODSTR=""
  1. F S MODSTR=$O(^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,"MOD",MODSTR)) Q:MODSTR="" D
  1. . W !?10,MODSTR_" ("_^TMP("ECRPROC",$J,ECLOC,ECUNIT,ECPROV,ECCAT,ECPRC,"MOD",MODSTR)_")"
  1. . I ($Y+6)>IOSL D PAGE
  1. Q
  1. ;
  1. ECPCHK(PROC,ECPROC) ;Procedure Code check
  1. N PRO,PX
  1. I PROC["EC" D
  1. .S PROC=$G(^EC(725,$P(PROC,";"),0)),PX=$P(PROC,U,2)_"~"_$P(PROC,U)
  1. E S PROC=$$CPT^ICPTCOD($P(PROC,";")) S PX=$P(PROC,U,2)_"~"_$P(PROC,U,3)
  1. I '$D(ECPROC($P(PX,"~"))) Q 0
  1. Q 1
  1. ;
  1. EXIT ;common exit point
  1. K ^TMP("ECRPROC",$J),^TMP("ECTMP",$J)
  1. Q