ECRRPT1.m

ECRRPT1 ;ALB/JAM-Event Capture Report RPC Broker ;Sep 22, 2020@17:05:23

 ;;2.0;EVENT CAPTURE;**25,32,33,61,78,72,90,95,100,107,112,119,139,145,152**;8 May 96;Build 19

 ;

 ;119 Updated comments for reports to include (E)xport as a value for ECPTYP

ECRPRSN ;Procedure Reason Report for RPC Call

 ;     Variables passed in

 ;       ECSD     - Start Date or Report

 ;       ECED     - End Date or Report

 ;       ECL0..n  - Location to report (1,some or ALL)

 ;       ECD0..n  - DSS Unit to report (1,some or ALL)

 ;       ECRY0..n - Procedure reason (some or ALL)

 ;       ECPTYP   - Where to send output (P)rinter, (D)evice or screen

 ;                  or (E)xport

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 N ECV,ECI,ECLOC,ECDSSU,ECDN,ECDATE,ECUN,ECNT,ECKEY,ECX,ECLINK,ECZ

 N ECROU,ECSAVE,ECDESC,ECW,DIC,X,Y,I,LIEN,ECJ

 S ECV="ECL0^ECD0^ECSD^ECED^ECRY0" D REQCHK^ECRRPT(ECV) I ECERR Q  ;112

 D  I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location." Q

 . D LOCARRY^ECRUTL I ECL0="ALL" Q  ;112

 . K ECLOC F I=0:1 S LIEN=$G(@("ECL"_I)) Q:'+LIEN  I $D(ECLOC1(LIEN)) S ECLOC(I+1)=LIEN_"^"_ECLOC1(LIEN) ;112

 D  I '$D(ECDSSU) S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q

 . I ECD0="ALL" D  Q

 . . I '$D(ECDUZ) Q

 . . S ECKEY=$S($D(^XUSEC("ECALLU",ECDUZ)):1,1:0) D ALLU^ECRUTL

 . S (ECI,ECNT)=0 F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX)  D

 . . K DIC S DIC=724,DIC(0)="QNZX",X=@ECX D ^DIC I Y<0 Q  ;145

 . . S ECNT=ECNT+1,ECDSSU(ECNT)=Y

 S ECX=0 D

 .I ECRY0="ALL" D PXREAS Q

 .N TLOC,TDSS,ECY

 .S ECI=0 F  S ECI=$O(ECLOC(ECI)) Q:'ECI  S TLOC(+ECLOC(ECI))=""

 .S ECI=0 F  S ECI=$O(ECDSSU(ECI)) Q:'ECI  S TDSS(+ECDSSU(ECI))=""

 .S ECI=0 F ECI=0:1 S ECZ="ECRY"_ECI Q:'$D(@ECZ)  D

 ..S ECW=0 F  S ECW=$O(^ECL("B",@ECZ,ECW)) Q:'ECW  D

 ...S ECY=$P($G(^ECL(ECW,0)),U,2) Q:ECY=""  S ECJ=$P($G(^ECJ(ECY,0)),U)

 ...Q:ECJ=""  Q:'$D(TLOC($P(ECJ,"-")))  Q:'$D(TDSS($P(ECJ,"-",2)))

 ...S ECLINK(ECW)=$P($G(^ECL(ECW,0)),U)

 D DATECHK^ECRRPT(.ECSD,.ECED) S ECSD=ECSD-.0001,ECED=ECED+.9999

 I ECPTYP="P" D  Q

 . S ECV="ECSD^ECED^ECPTYP",ECROU="STRPT^ECRPRSN2"

 . S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("),ECSAVE("ECLINK("))=""

 . S ECDESC="EC Procedure Reason Report"

 . D QUEUE^ECRRPT

 D STRPT^ECRPRSN2 ;112

 Q

PXREAS ;Procedure reason link

 N ECZ,ECX,ECY,ECV

 S ECX=0 F  S ECX=$O(ECLOC(ECX)) Q:'ECX  S ECY=0 D

 . F  S ECY=$O(ECDSSU(ECY)) Q:'ECY  S ECV=+ECLOC(ECX)_"-"_+ECDSSU(ECY) D

 . . S ECZ=ECV_"-0-0"

 . . F  S ECZ=$O(^ECJ("B",ECZ)) Q:('ECZ)!($P(ECZ,"-",1,2)'=ECV)  D

 . . . S ECW=$O(^ECJ("B",ECZ,"")) Q:ECW=""  D REALNK

 Q

REALNK ;Reason link

 N XX,YY,ZZ

 S XX=0 F  S XX=$O(^ECL("AD",ECW,XX)) Q:'XX  S YY=0 D

 . F  S YY=$O(^ECL("AD",ECW,XX,YY)) Q:'YY  D

 . . Q:$G(^ECL(YY,0))=""  S ECLINK(YY)=XX

 Q

ECRPERS ;Inactive Person Class Report for RPC Call

 ;     Variables passed in

 ;       ECSD   - Start Date or Report

 ;       ECED   - End Date or Report

 ;       ECSORT - Sort by Patient (P) or Provider (R)

 ;       ECPTYP - Where to send output (P)rinter, (D)evice or screen

 ;                or (E)xport

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 N ECV,ECDATE,ECBEGIN,ECEND,ECROU,ECDESC

 S ECV="ECSD^ECED^ECSORT" D REQCHK^ECRRPT(ECV) I ECERR Q

 D DATECHK^ECRRPT(.ECSD,.ECED)

 S ECBEGIN=ECSD-.0001,ECEND=ECED+.9999

 I ECPTYP="P" D  Q

 . S ECV="ECBEGIN^ECEND^ECSORT",ECROU="START^ECRPCLS"

 . S ECDESC="EC Invalid Provider Report"

 . D QUEUE^ECRRPT

 D START^ECRPCLS

 Q

ECDSS1 ;National/Local Procedure Reports for RPC Call

 ;     Variables passed in

 ;       ECRTN    - Procedure Report (A-active or I-inactive)

 ;       ECPTYP   - Where to send output (P)rinter, (D)evice or screen

 ;                  or (E)xport

 ;    If ECRTN=A, also

 ;       ECRN     - Preferred Report (N-ational, L-ocal or Both)

 ;       ECRD     - Sort Method (P-rocedure Name, N-ational Number)

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 N ECV,ECDESC,ECROU,DQTIME

 S ECV=$S($G(ECRTN)="A":"ECRTN^ECRN^ECRD",1:"ECRTN")

 D REQCHK^ECRRPT(ECV) I ECERR Q

 S DQTIME=ECQDT

 I $G(ECPTYP)="E" D @$S(ECRTN="I":"LISTI^ECDSS1",1:"PRT^ECDSS1") Q  ;119

 I ECPTYP="P" D  Q

 . S ECV="ECRTN^ECRN^ECRD",ECROU=$S(ECRTN="I":"LISTI",1:"PRT")_"^ECDSS1"

 . S ECDESC="Event Capture National Procedure Report",ECDIP=1

 . ;S ECSAVE("IO*")=""

 .D QUEDIP D @$S(ECRTN="I":"LISTI^ECDSS1",1:"PRT^ECDSS1")

 D CLOSE^%ZISH(ECDIRY_ECFILER)

 S %ZIS("HFSNAME")=ECDIRY_ECFILER,%ZIS("HFSMODE")="W",IOP="HFS"_";132" ;145 Add right margin width

 D @$S(ECRTN="I":"LISTI^ECDSS1",1:"PRT^ECDSS1")

 Q

ECDSS3 ;Category Reports for RPC Call

 ;     Variables passed in

 ;       ECRTN    - Category Procedure Report

 ;                  (A-active, I-inactive or B-oth)

 ;       ECPTYP   - Where to send output (P)rinter, (D)evice or screen

 ;                  or (E)xport

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 N ECV,ECDIP,DQTIME

 S ECV="ECRTN" D REQCHK^ECRRPT(ECV) I ECERR Q

 S DQTIME=ECQDT

 I $G(ECPTYP)="E" D PRINT^ECDSS3 Q  ;119

 I ECPTYP="P" D  Q

 . S ECV="ECRTN",ECROU="PRINT^ECDSS3"

 . S ECDESC="Event Capture Category Reports"

 . D QUEDIP D PRINT^ECDSS3

 D CLOSE^%ZISH(ECDIRY_ECFILER)

 S %ZIS("HFSNAME")=ECDIRY_ECFILER,%ZIS("HFSMODE")="W",IOP="HFS"_";132" ;145 Add right margin width

 D PRINT^ECDSS3

 Q

QUEDIP ;Queue when using DIP

 N DIC,X,Y

 D  I Y=-1 S ECERR=1 Q

 . S DIC(0)="MN",X=ECDEV,DIC="^%ZIS(1," D ^DIC

 . S:+Y>0 IOP="Q;"_$P(Y,U,2)

 . S Y=ECQDT X ^DD("DD") S DQTIME=Y

 Q

ECSUM ;Print Category and Procedure Summary (Report) for RPC Call

 ;     Variables passed in

 ;       ECL      - Location to report (1 or ALL)

 ;       ECD0...n - DSS Unit to report (ECD0, first unit, ECD1, second

 ;                  unit, etc.)

 ;       ECC      - Category (defaults to ALL, even if sent) (optional)

 ;       ECRTN    - Event Code Screen (Active, Inactive or Both)

 ;       ECPTYP   - Where to send output (P)rinter, (D)evice or screen

 ;                  or (E)xport

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 N ECV,ECDN,ECCN,ECROU,ECSAVE,ECDESC,ECLOC,ECS,ECJLP,ECSN,ECALL,DIC,X,Y

 N ECSCN,ECUNITS,ECNUM ;139

 S (ECJLP,ECALL)=0,ECV="ECL^ECD0^ECRTN" D REQCHK^ECRRPT(ECV) I ECERR Q  ;139

 D  I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location." Q

 . D LOCARRY^ECRUTL I ECL="ALL" Q

 . K ECLOC I $D(ECLOC1(ECL)) S ECLOC(1)=ECL_"^"_ECLOC1(ECL)

 S ECSCN=ECRTN,ECD="ALL",ECALL=1 ;139

 F ECNUM=0:1 Q:'$D(@("ECD"_ECNUM))  S ECUNITS(@("ECD"_ECNUM))="" K @("ECD"_ECNUM) ;139 Convert DSS units to array of units

 I ECALL D PXRUN Q

PXRUN I ECPTYP="P" D  Q

 . S ECV="ECALL^ECSCN",ECROU="START^ECSUM"

 . S ECSAVE("ECLOC(")=""

 . S ECSAVE("ECUNITS(")="" ;139 Save units for queued report

 . I 'ECALL S ECV=ECV_"^ECD^ECC^ECSN^ECDN^ECJLP^ECCN^ECSCN"

 . S ECDESC="EC Print Category and Procedure Summary"

 . D QUEUE^ECRRPT

 U IO D START^ECSUM

 Q

ECNTPCE ;ECS Records Failing Transmission to PCE

 ;     Variables passed in

 ;       ECSD   - Start Date or Report

 ;       ECED   - End Date or Report

 ;       ECPTYP - Where to send output (P)rinter, (D)evice or screen

 ;                or (E)xport

 ;       ECL0..n - Location to report (1,some or ALL)

 ;       ECD0..n - DSS unit to report (1,some or ALL)

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 N ECV,ECDATE,ECROU,ECDESC

 N ECLOC,ECLOC1,ECDSSU,LIEN,ECNT,ECI,ECKEY,ECX,I,X,Y ; 152

 S ECV="ECSD^ECED^ECL0^ECD0" D REQCHK^ECRRPT(ECV) I ECERR Q  ;152 - Added Location and DSS Units

 ;*** 152 Starts ***

 D  I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location." Q

 . D LOCARRY^ECRUTL I ECL0="ALL" Q  ;112

 . K ECLOC F I=0:1 S LIEN=$G(@("ECL"_I)) Q:'+LIEN  I $D(ECLOC1(LIEN)) S ECLOC(I+1)=LIEN_"^"_ECLOC1(LIEN)

 D  I '$D(ECDSSU) S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q

 . I ECD0="ALL" D  Q

 . . I '$D(ECDUZ) Q

 . . S ECKEY=$S($D(^XUSEC("ECALLU",ECDUZ)):1,1:0) D ALLU^ECRUTL

 . S (ECI,ECNT)=0 F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX)  D

 . . K DIC S DIC=724,DIC(0)="QNZX",X=@ECX D ^DIC I Y<0 Q

 . . S ECNT=ECNT+1,ECDSSU(ECNT)=Y

 ;*** 152 Ends ***

 D DATECHK^ECRRPT(.ECSD,.ECED)

 S ECSD=ECSD-.0001,ECED=ECED+.9999

 I ECPTYP="P" D  Q

 . S ECV="ECSD^ECED^ECDATE^ECL0^ECD0",ECROU="START^ECNTPCE" ;152 - Added Location and DSS Units

 . S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))="" ;152

 . S ECDESC="ECS Records Failing Transmission to PCE Report"

 . D QUEUE^ECRRPT

 D START^ECNTPCE

 Q

ECSCPT ;Event Code Screens with CPT Codes

 ;     Variables passed in

 ;       ECL      - Location to report (1 or ALL)

 ;       ECD      - DSS Unit to report (1 or ALL), If ECD'="ALL" then ECC

 ;       ECC      - Category (1 or ALL) (optional)

 ;       ECCPT    - CPT Codes to Display (Active, Inactive or Both)

 ;       ECPTYP   - Where to send output (P)rinter, (D)evice or screen

 ;                  or (E)xport

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 N ECV,ECDN,ECCN,ECROU,ECSAVE,ECDESC,ECLOC,ECS,ECJLP,ECALL,DIC,X,Y

 S (ECJLP,ECALL)=0,ECV="ECL^ECD^ECCPT" D REQCHK^ECRRPT(ECV) I ECERR Q

 D  I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location." Q

 . I ECL="ALL" D LOCARRY^ECRUTL Q

 . S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC Q:Y<0  S ECLOC(1)=+Y_U_$P(Y,U,2)

 D  I ECERR S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q

 . I ECD="ALL" S ECALL=1 Q

 . K DIC S DIC=724,DIC(0)="QNZX",X=ECD D ^DIC I Y<0 S ECERR=1 Q  ;145

 . S ECDN=$P(Y,U,2)_$S($P($G(^ECD(+ECD,0)),"^",6):" **Inactive**",1:"")

 . S ECJLP=+$P(^ECD(ECD,0),"^",11)

 . I 'ECJLP S ECC=0,ECCN="None"

 I ECALL D CPTRUN Q

 S ECV="ECC" D REQCHK^ECRRPT(ECV) I ECERR Q

 D  I ECERR S ^TMP("ECMSG",$J)="1^Invalid Category." Q

 . I (ECC="ALL")!(ECC=0) Q

 . K DIC S DIC=726,DIC(0)="QNMZX",X=ECC D ^DIC I Y<0 S ECERR=1 Q

 . S ECCN=$P(Y,U,2)

CPTRUN I ECPTYP="P" D  Q

 . S ECV="ECALL^ECCPT",ECROU="START^ECSCPT"

 . S ECSAVE("ECLOC(")=""

 . I 'ECALL S ECV=ECV_"^ECD^ECC^ECDN^ECJLP^ECCN"

 . S ECDESC="Event Code Screens with CPT Codes"

 . D QUEUE^ECRRPT

 U IO D START^ECSCPT

 Q

ECINCPT ;National/Local Procedure Codes with Inactive CPT Reports for RPC Call

 ;     Variables passed in

 ;       ECPTYP  - Where to send output (P)rinter, (D)evice or screen

 ;                 or (E)xport

 ;  152 - Adding the next three variables

 ;       ECRN     - Preferred Report (N-ational, L-ocal or Both)

 ;       ECSM     - Sort Method (P-rocedure Name, N-ational Number,C-PT Code,D-Inactive Date)

 ;       ECSORT   - Sort Order "A"scending, "D"escending

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 N ECV,ECL,ECDESC,ECROU,DQTIME,ECPG

 S ECV="ECRN^ECSM^ECSORT" D REQCHK^ECRRPT(ECV) I ECERR Q  ;152

 S ECPG=1

 I ECPTYP="P" D  Q

 . S ECV="ECRN^ECSM^ECSORT",ECROU="START^ECINCPT" ;152 ,ECV="ECL",ECL=""

 . S ECDESC="National/Local Procedure Codes with Inactive CPT"

 . D QUEUE^ECRRPT

 U IO D START^ECINCPT

 Q

ECGTP ;ECS Generic Table Printer

 ;     Variables passed in

 ;       ECOBHNDL   - Handle to generic table print obj

 ;       ECPTYP     - Where to send output (P)rinter, (D)evice or screen

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 N ECV,ECROU,ECDESC

 S ECV="ECOBHNDL" D REQCHK^ECRRPT(ECV) I ECERR Q

 I ECPTYP="P" D  Q

 . S ECV="ECOBHNDL",ECROU="START^ECGTP"

 . S ECDESC="ECS Generic Table Printer"

 . D QUEUE^ECRRPT

 D START^ECGTP

 Q

ECSTPCD ;DSS Units with Associated Stop Code Error REPORT

 ;  EC*2*107 - added to GUI reports

 ;     Variables passed in

 ;       ECPTYP  - Where to send output (P)rinter, (D)evice or screen

 ;                 or (E)xport

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 N ECV,ECL,ECDESC,ECROU,DQTIME,ECPG

 S ECPG=1

 I ECPTYP="P" D  Q

 . S ECROU="STRTGUI^ECUNTRPT",ECV="ECL",ECL=""

 . S ECDESC="DSS Units with Associated Stop Code Error"

 . D QUEUE^ECRRPT

 U IO D STRTGUI^ECUNTRPT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECRRPT1   12096     printed  Mar 13, 2025@21:03:35                                                                                                                                                                                                    Page 2

ECRRPT1   ;ALB/JAM-Event Capture Report RPC Broker ;Sep 22, 2020@17:05:23

 +1       ;;2.0;EVENT CAPTURE;**25,32,33,61,78,72,90,95,100,107,112,119,139,145,152**;8 May 96;Build 19

 +2       ;

 +3       ;119 Updated comments for reports to include (E)xport as a value for ECPTYP

ECRPRSN   ;Procedure Reason Report for RPC Call

 +1       ;     Variables passed in

 +2       ;       ECSD     - Start Date or Report

 +3       ;       ECED     - End Date or Report

 +4       ;       ECL0..n  - Location to report (1,some or ALL)

 +5       ;       ECD0..n  - DSS Unit to report (1,some or ALL)

 +6       ;       ECRY0..n - Procedure reason (some or ALL)

 +7       ;       ECPTYP   - Where to send output (P)rinter, (D)evice or screen

 +8       ;                  or (E)xport

 +9       ;

 +10      ;     Variable return

 +11      ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 +12       NEW ECV,ECI,ECLOC,ECDSSU,ECDN,ECDATE,ECUN,ECNT,ECKEY,ECX,ECLINK,ECZ

 +13       NEW ECROU,ECSAVE,ECDESC,ECW,DIC,X,Y,I,LIEN,ECJ

 +14      ;112

           SET ECV="ECL0^ECD0^ECSD^ECED^ECRY0"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +15       Begin DoDot:1

 +16      ;112

               DO LOCARRY^ECRUTL

               IF ECL0="ALL"

                   QUIT 

 +17      ;112

               KILL ECLOC

               FOR I=0:1

                   SET LIEN=$GET(@("ECL"_I))

                   if '+LIEN

                       QUIT 

                   IF $DATA(ECLOC1(LIEN))

                       SET ECLOC(I+1)=LIEN_"^"_ECLOC1(LIEN)

           End DoDot:1

           IF '$DATA(ECLOC)

               SET ^TMP("ECMSG",$JOB)="1^Invalid Location."

               QUIT 

 +18       Begin DoDot:1

 +19           IF ECD0="ALL"

                   Begin DoDot:2

 +20                   IF '$DATA(ECDUZ)

                           QUIT 

 +21                   SET ECKEY=$SELECT($DATA(^XUSEC("ECALLU",ECDUZ)):1,1:0)

                       DO ALLU^ECRUTL

                   End DoDot:2

                   QUIT 

 +22           SET (ECI,ECNT)=0

               FOR ECI=0:1

                   SET ECX="ECD"_ECI

                   if '$DATA(@ECX)

                       QUIT 

                   Begin DoDot:2

 +23      ;145

                       KILL DIC

                       SET DIC=724

                       SET DIC(0)="QNZX"

                       SET X=@ECX

                       DO ^DIC

                       IF Y<0

                           QUIT 

 +24                   SET ECNT=ECNT+1

                       SET ECDSSU(ECNT)=Y

                   End DoDot:2

           End DoDot:1

           IF '$DATA(ECDSSU)

               SET ^TMP("ECMSG",$JOB)="1^Invalid DSS Unit."

               QUIT 

 +25       SET ECX=0

           Begin DoDot:1

 +26           IF ECRY0="ALL"

                   DO PXREAS

                   QUIT 

 +27           NEW TLOC,TDSS,ECY

 +28           SET ECI=0

               FOR 

                   SET ECI=$ORDER(ECLOC(ECI))

                   if 'ECI

                       QUIT 

                   SET TLOC(+ECLOC(ECI))=""

 +29           SET ECI=0

               FOR 

                   SET ECI=$ORDER(ECDSSU(ECI))

                   if 'ECI

                       QUIT 

                   SET TDSS(+ECDSSU(ECI))=""

 +30           SET ECI=0

               FOR ECI=0:1

                   SET ECZ="ECRY"_ECI

                   if '$DATA(@ECZ)

                       QUIT 

                   Begin DoDot:2

 +31                   SET ECW=0

                       FOR 

                           SET ECW=$ORDER(^ECL("B",@ECZ,ECW))

                           if 'ECW

                               QUIT 

                           Begin DoDot:3

 +32                           SET ECY=$PIECE($GET(^ECL(ECW,0)),U,2)

                               if ECY=""

                                   QUIT 

                               SET ECJ=$PIECE($GET(^ECJ(ECY,0)),U)

 +33                           if ECJ=""

                                   QUIT 

                               if '$DATA(TLOC($PIECE(ECJ,"-")))

                                   QUIT 

                               if '$DATA(TDSS($PIECE(ECJ,"-",2)))

                                   QUIT 

 +34                           SET ECLINK(ECW)=$PIECE($GET(^ECL(ECW,0)),U)

                           End DoDot:3

                   End DoDot:2

           End DoDot:1

 +35       DO DATECHK^ECRRPT(.ECSD,.ECED)

           SET ECSD=ECSD-.0001

           SET ECED=ECED+.9999

 +36       IF ECPTYP="P"

               Begin DoDot:1

 +37               SET ECV="ECSD^ECED^ECPTYP"

                   SET ECROU="STRPT^ECRPRSN2"

 +38               SET (ECSAVE("ECLOC("),ECSAVE("ECDSSU("),ECSAVE("ECLINK("))=""

 +39               SET ECDESC="EC Procedure Reason Report"

 +40               DO QUEUE^ECRRPT

               End DoDot:1

               QUIT 

 +41      ;112

           DO STRPT^ECRPRSN2

 +42       QUIT 

PXREAS    ;Procedure reason link

 +1        NEW ECZ,ECX,ECY,ECV

 +2        SET ECX=0

           FOR 

               SET ECX=$ORDER(ECLOC(ECX))

               if 'ECX

                   QUIT 

               SET ECY=0

               Begin DoDot:1

 +3                FOR 

                       SET ECY=$ORDER(ECDSSU(ECY))

                       if 'ECY

                           QUIT 

                       SET ECV=+ECLOC(ECX)_"-"_+ECDSSU(ECY)

                       Begin DoDot:2

 +4                        SET ECZ=ECV_"-0-0"

 +5                        FOR 

                               SET ECZ=$ORDER(^ECJ("B",ECZ))

                               if ('ECZ)!($PIECE(ECZ,"-",1,2)'=ECV)

                                   QUIT 

                               Begin DoDot:3

 +6                                SET ECW=$ORDER(^ECJ("B",ECZ,""))

                                   if ECW=""

                                       QUIT 

                                   DO REALNK

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +7        QUIT 

REALNK    ;Reason link

 +1        NEW XX,YY,ZZ

 +2        SET XX=0

           FOR 

               SET XX=$ORDER(^ECL("AD",ECW,XX))

               if 'XX

                   QUIT 

               SET YY=0

               Begin DoDot:1

 +3                FOR 

                       SET YY=$ORDER(^ECL("AD",ECW,XX,YY))

                       if 'YY

                           QUIT 

                       Begin DoDot:2

 +4                        if $GET(^ECL(YY,0))=""

                               QUIT 

                           SET ECLINK(YY)=XX

                       End DoDot:2

               End DoDot:1

 +5        QUIT 

ECRPERS   ;Inactive Person Class Report for RPC Call

 +1       ;     Variables passed in

 +2       ;       ECSD   - Start Date or Report

 +3       ;       ECED   - End Date or Report

 +4       ;       ECSORT - Sort by Patient (P) or Provider (R)

 +5       ;       ECPTYP - Where to send output (P)rinter, (D)evice or screen

 +6       ;                or (E)xport

 +7       ;

 +8       ;     Variable return

 +9       ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 +10       NEW ECV,ECDATE,ECBEGIN,ECEND,ECROU,ECDESC

 +11       SET ECV="ECSD^ECED^ECSORT"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +12       DO DATECHK^ECRRPT(.ECSD,.ECED)

 +13       SET ECBEGIN=ECSD-.0001

           SET ECEND=ECED+.9999

 +14       IF ECPTYP="P"

               Begin DoDot:1

 +15               SET ECV="ECBEGIN^ECEND^ECSORT"

                   SET ECROU="START^ECRPCLS"

 +16               SET ECDESC="EC Invalid Provider Report"

 +17               DO QUEUE^ECRRPT

               End DoDot:1

               QUIT 

 +18       DO START^ECRPCLS

 +19       QUIT 

ECDSS1    ;National/Local Procedure Reports for RPC Call

 +1       ;     Variables passed in

 +2       ;       ECRTN    - Procedure Report (A-active or I-inactive)

 +3       ;       ECPTYP   - Where to send output (P)rinter, (D)evice or screen

 +4       ;                  or (E)xport

 +5       ;    If ECRTN=A, also

 +6       ;       ECRN     - Preferred Report (N-ational, L-ocal or Both)

 +7       ;       ECRD     - Sort Method (P-rocedure Name, N-ational Number)

 +8       ;

 +9       ;     Variable return

 +10      ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 +11       NEW ECV,ECDESC,ECROU,DQTIME

 +12       SET ECV=$SELECT($GET(ECRTN)="A":"ECRTN^ECRN^ECRD",1:"ECRTN")

 +13       DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +14       SET DQTIME=ECQDT

 +15      ;119

           IF $GET(ECPTYP)="E"

               DO @$SELECT(ECRTN="I":"LISTI^ECDSS1",1:"PRT^ECDSS1")

               QUIT 

 +16       IF ECPTYP="P"

               Begin DoDot:1

 +17               SET ECV="ECRTN^ECRN^ECRD"

                   SET ECROU=$SELECT(ECRTN="I":"LISTI",1:"PRT")_"^ECDSS1"

 +18               SET ECDESC="Event Capture National Procedure Report"

                   SET ECDIP=1

 +19      ;S ECSAVE("IO*")=""

 +20               DO QUEDIP

                   DO @$SELECT(ECRTN="I":"LISTI^ECDSS1",1:"PRT^ECDSS1")

               End DoDot:1

               QUIT 

 +21       DO CLOSE^%ZISH(ECDIRY_ECFILER)

 +22      ;145 Add right margin width

           SET %ZIS("HFSNAME")=ECDIRY_ECFILER

           SET %ZIS("HFSMODE")="W"

           SET IOP="HFS"_";132"

 +23       DO @$SELECT(ECRTN="I":"LISTI^ECDSS1",1:"PRT^ECDSS1")

 +24       QUIT 

ECDSS3    ;Category Reports for RPC Call

 +1       ;     Variables passed in

 +2       ;       ECRTN    - Category Procedure Report

 +3       ;                  (A-active, I-inactive or B-oth)

 +4       ;       ECPTYP   - Where to send output (P)rinter, (D)evice or screen

 +5       ;                  or (E)xport

 +6       ;

 +7       ;     Variable return

 +8       ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 +9        NEW ECV,ECDIP,DQTIME

 +10       SET ECV="ECRTN"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +11       SET DQTIME=ECQDT

 +12      ;119

           IF $GET(ECPTYP)="E"

               DO PRINT^ECDSS3

               QUIT 

 +13       IF ECPTYP="P"

               Begin DoDot:1

 +14               SET ECV="ECRTN"

                   SET ECROU="PRINT^ECDSS3"

 +15               SET ECDESC="Event Capture Category Reports"

 +16               DO QUEDIP

                   DO PRINT^ECDSS3

               End DoDot:1

               QUIT 

 +17       DO CLOSE^%ZISH(ECDIRY_ECFILER)

 +18      ;145 Add right margin width

           SET %ZIS("HFSNAME")=ECDIRY_ECFILER

           SET %ZIS("HFSMODE")="W"

           SET IOP="HFS"_";132"

 +19       DO PRINT^ECDSS3

 +20       QUIT 

QUEDIP    ;Queue when using DIP

 +1        NEW DIC,X,Y

 +2        Begin DoDot:1

 +3            SET DIC(0)="MN"

               SET X=ECDEV

               SET DIC="^%ZIS(1,"

               DO ^DIC

 +4            if +Y>0

                   SET IOP="Q;"_$PIECE(Y,U,2)

 +5            SET Y=ECQDT

               XECUTE ^DD("DD")

               SET DQTIME=Y

           End DoDot:1

           IF Y=-1

               SET ECERR=1

               QUIT 

 +6        QUIT 

ECSUM     ;Print Category and Procedure Summary (Report) for RPC Call

 +1       ;     Variables passed in

 +2       ;       ECL      - Location to report (1 or ALL)

 +3       ;       ECD0...n - DSS Unit to report (ECD0, first unit, ECD1, second

 +4       ;                  unit, etc.)

 +5       ;       ECC      - Category (defaults to ALL, even if sent) (optional)

 +6       ;       ECRTN    - Event Code Screen (Active, Inactive or Both)

 +7       ;       ECPTYP   - Where to send output (P)rinter, (D)evice or screen

 +8       ;                  or (E)xport

 +9       ;

 +10      ;     Variable return

 +11      ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 +12       NEW ECV,ECDN,ECCN,ECROU,ECSAVE,ECDESC,ECLOC,ECS,ECJLP,ECSN,ECALL,DIC,X,Y

 +13      ;139

           NEW ECSCN,ECUNITS,ECNUM

 +14      ;139

           SET (ECJLP,ECALL)=0

           SET ECV="ECL^ECD0^ECRTN"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +15       Begin DoDot:1

 +16           DO LOCARRY^ECRUTL

               IF ECL="ALL"

                   QUIT 

 +17           KILL ECLOC

               IF $DATA(ECLOC1(ECL))

                   SET ECLOC(1)=ECL_"^"_ECLOC1(ECL)

           End DoDot:1

           IF '$DATA(ECLOC)

               SET ^TMP("ECMSG",$JOB)="1^Invalid Location."

               QUIT 

 +18      ;139

           SET ECSCN=ECRTN

           SET ECD="ALL"

           SET ECALL=1

 +19      ;139 Convert DSS units to array of units

           FOR ECNUM=0:1

               if '$DATA(@("ECD"_ECNUM))

                   QUIT 

               SET ECUNITS(@("ECD"_ECNUM))=""

               KILL @("ECD"_ECNUM)

 +20       IF ECALL

               DO PXRUN

               QUIT 

PXRUN      IF ECPTYP="P"

               Begin DoDot:1

 +1                SET ECV="ECALL^ECSCN"

                   SET ECROU="START^ECSUM"

 +2                SET ECSAVE("ECLOC(")=""

 +3       ;139 Save units for queued report

                   SET ECSAVE("ECUNITS(")=""

 +4                IF 'ECALL

                       SET ECV=ECV_"^ECD^ECC^ECSN^ECDN^ECJLP^ECCN^ECSCN"

 +5                SET ECDESC="EC Print Category and Procedure Summary"

 +6                DO QUEUE^ECRRPT

               End DoDot:1

               QUIT 

 +7        USE IO

           DO START^ECSUM

 +8        QUIT 

ECNTPCE   ;ECS Records Failing Transmission to PCE

 +1       ;     Variables passed in

 +2       ;       ECSD   - Start Date or Report

 +3       ;       ECED   - End Date or Report

 +4       ;       ECPTYP - Where to send output (P)rinter, (D)evice or screen

 +5       ;                or (E)xport

 +6       ;       ECL0..n - Location to report (1,some or ALL)

 +7       ;       ECD0..n - DSS unit to report (1,some or ALL)

 +8       ;     Variable return

 +9       ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 +10       NEW ECV,ECDATE,ECROU,ECDESC

 +11      ; 152

           NEW ECLOC,ECLOC1,ECDSSU,LIEN,ECNT,ECI,ECKEY,ECX,I,X,Y

 +12      ;152 - Added Location and DSS Units

           SET ECV="ECSD^ECED^ECL0^ECD0"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +13      ;*** 152 Starts ***

 +14       Begin DoDot:1

 +15      ;112

               DO LOCARRY^ECRUTL

               IF ECL0="ALL"

                   QUIT 

 +16           KILL ECLOC

               FOR I=0:1

                   SET LIEN=$GET(@("ECL"_I))

                   if '+LIEN

                       QUIT 

                   IF $DATA(ECLOC1(LIEN))

                       SET ECLOC(I+1)=LIEN_"^"_ECLOC1(LIEN)

           End DoDot:1

           IF '$DATA(ECLOC)

               SET ^TMP("ECMSG",$JOB)="1^Invalid Location."

               QUIT 

 +17       Begin DoDot:1

 +18           IF ECD0="ALL"

                   Begin DoDot:2

 +19                   IF '$DATA(ECDUZ)

                           QUIT 

 +20                   SET ECKEY=$SELECT($DATA(^XUSEC("ECALLU",ECDUZ)):1,1:0)

                       DO ALLU^ECRUTL

                   End DoDot:2

                   QUIT 

 +21           SET (ECI,ECNT)=0

               FOR ECI=0:1

                   SET ECX="ECD"_ECI

                   if '$DATA(@ECX)

                       QUIT 

                   Begin DoDot:2

 +22                   KILL DIC

                       SET DIC=724

                       SET DIC(0)="QNZX"

                       SET X=@ECX

                       DO ^DIC

                       IF Y<0

                           QUIT 

 +23                   SET ECNT=ECNT+1

                       SET ECDSSU(ECNT)=Y

                   End DoDot:2

           End DoDot:1

           IF '$DATA(ECDSSU)

               SET ^TMP("ECMSG",$JOB)="1^Invalid DSS Unit."

               QUIT 

 +24      ;*** 152 Ends ***

 +25       DO DATECHK^ECRRPT(.ECSD,.ECED)

 +26       SET ECSD=ECSD-.0001

           SET ECED=ECED+.9999

 +27       IF ECPTYP="P"

               Begin DoDot:1

 +28      ;152 - Added Location and DSS Units

                   SET ECV="ECSD^ECED^ECDATE^ECL0^ECD0"

                   SET ECROU="START^ECNTPCE"

 +29      ;152

                   SET (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""

 +30               SET ECDESC="ECS Records Failing Transmission to PCE Report"

 +31               DO QUEUE^ECRRPT

               End DoDot:1

               QUIT 

 +32       DO START^ECNTPCE

 +33       QUIT 

ECSCPT    ;Event Code Screens with CPT Codes

 +1       ;     Variables passed in

 +2       ;       ECL      - Location to report (1 or ALL)

 +3       ;       ECD      - DSS Unit to report (1 or ALL), If ECD'="ALL" then ECC

 +4       ;       ECC      - Category (1 or ALL) (optional)

 +5       ;       ECCPT    - CPT Codes to Display (Active, Inactive or Both)

 +6       ;       ECPTYP   - Where to send output (P)rinter, (D)evice or screen

 +7       ;                  or (E)xport

 +8       ;

 +9       ;     Variable return

 +10      ;       ^TMP($J,"ECRPT",n)=report output or to print device.

 +11       NEW ECV,ECDN,ECCN,ECROU,ECSAVE,ECDESC,ECLOC,ECS,ECJLP,ECALL,DIC,X,Y

 +12       SET (ECJLP,ECALL)=0

           SET ECV="ECL^ECD^ECCPT"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +13       Begin DoDot:1

 +14           IF ECL="ALL"

                   DO LOCARRY^ECRUTL

                   QUIT 

 +15           SET DIC=4

               SET DIC(0)="QNZX"

               SET X=ECL

               DO ^DIC

               if Y<0

                   QUIT 

               SET ECLOC(1)=+Y_U_$PIECE(Y,U,2)

           End DoDot:1

           IF '$DATA(ECLOC)

               SET ^TMP("ECMSG",$JOB)="1^Invalid Location."

               QUIT 

 +16       Begin DoDot:1

 +17           IF ECD="ALL"

                   SET ECALL=1

                   QUIT 

 +18      ;145

               KILL DIC

               SET DIC=724

               SET DIC(0)="QNZX"

               SET X=ECD

               DO ^DIC

               IF Y<0

                   SET ECERR=1

                   QUIT 

 +19           SET ECDN=$PIECE(Y,U,2)_$SELECT($PIECE($GET(^ECD(+ECD,0)),"^",6):" **Inactive**",1:"")

 +20           SET ECJLP=+$PIECE(^ECD(ECD,0),"^",11)