ECDISSUM ;ALB/DAN - Disabled Category & Procedure Summary Rpt ;9/27/17 11:21
;;2.0;EVENT CAPTURE;**131,139**;8 May 96;Build 7
;
EN ;
N CNT,ECRDT,ECPG,ECI,ECL,ECLN,ECDIS,ECD,ECC,ECSCN,ECOUT
U IO
S CNT=1,^TMP($J,"ECRPT",CNT)="EC SCREEN STATUS^LOCATION^SERVICE^DSS UNIT^DSS UNIT IEN^DSS DEPT^SEND STATUS^DSS UNIT INACTIVE^DISABLED CATEGORY^CPT CODE^PROCEDURE CODE"
S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_"^PROCEDURE NAME^SYNONYM^CLINIC IEN^CLINIC^STOP CODE^CREDIT STOP CODE^CHAR4 CODE^MCA LABOR CODE" ;139
S ECRDT=$$FMTE^XLFDT($$NOW^XLFDT),ECSCN="B",ECOUT=0
S ECPG=1,ECDIS=1 ;Indicates we're running the disabled category report
S ECI=0 F S ECI=$O(ECLOC(ECI)) Q:'+ECI D
.S ECL=$P(ECLOC(ECI),U),ECLN=$P(ECLOC(ECI),U,2)
.S ECD=0 F S ECD=$O(^ECJ("AP",ECL,ECD)) Q:'+ECD D
..I $P($G(^ECD(ECD,0)),U,11)=0,$O(^ECJ("AP",ECL,ECD,0)) S ECC="ALL" D SUM2^ECSUM1 ;If unit set to no categories but has event code screens with categories defined then print
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECDISSUM 979 printed Sep 23, 2025@19:33:09 Page 2
ECDISSUM ;ALB/DAN - Disabled Category & Procedure Summary Rpt ;9/27/17 11:21
+1 ;;2.0;EVENT CAPTURE;**131,139**;8 May 96;Build 7
+2 ;
EN ;
+1 NEW CNT,ECRDT,ECPG,ECI,ECL,ECLN,ECDIS,ECD,ECC,ECSCN,ECOUT
+2 USE IO
+3 SET CNT=1
SET ^TMP($JOB,"ECRPT",CNT)="EC SCREEN STATUS^LOCATION^SERVICE^DSS UNIT^DSS UNIT IEN^DSS DEPT^SEND STATUS^DSS UNIT INACTIVE^DISABLED CATEGORY^CPT CODE^PROCEDURE CODE"
+4 ;139
SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_"^PROCEDURE NAME^SYNONYM^CLINIC IEN^CLINIC^STOP CODE^CREDIT STOP CODE^CHAR4 CODE^MCA LABOR CODE"
+5 SET ECRDT=$$FMTE^XLFDT($$NOW^XLFDT)
SET ECSCN="B"
SET ECOUT=0
+6 ;Indicates we're running the disabled category report
SET ECPG=1
SET ECDIS=1
+7 SET ECI=0
FOR
SET ECI=$ORDER(ECLOC(ECI))
if '+ECI
QUIT
Begin DoDot:1
+8 SET ECL=$PIECE(ECLOC(ECI),U)
SET ECLN=$PIECE(ECLOC(ECI),U,2)
+9 SET ECD=0
FOR
SET ECD=$ORDER(^ECJ("AP",ECL,ECD))
if '+ECD
QUIT
Begin DoDot:2
+10 ;If unit set to no categories but has event code screens with categories defined then print
IF $PIECE($GET(^ECD(ECD,0)),U,11)=0
IF $ORDER(^ECJ("AP",ECL,ECD,0))
SET ECC="ALL"
DO SUM2^ECSUM1
End DoDot:2
End DoDot:1
+11 QUIT
