ECRRPT2.m

ECRRPT2 ;ALB/DAN - Event Capture Report RPC Broker (Cont) ;Nov 16, 2022@13:46:43

 ;;2.0;EVENT CAPTURE;**112,131,139,156,159**;8 May 96;Build 61

 ;

 ; Reference to ^TMP supported by SACC 2.3.2.5.1

 ; Reference to ^XUSEC(KEY) in ICR #10076

 ; Reference to ^DIC in ICR #10006

 ; Reference to ^VA(200, in ICR #10060

 ;

ECRDSSUA ;List users with access to DSS Units

 ;     Variables passed in

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

 ;       ECDUZ       - User IEN from file (#200)

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

 ;                     data will be returned in ^TMP($J,"ECRPT") in

 ;                     delimited format for export to spreadsheet

 ;

 ;     Variable return

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

 N ECDSSU,ECV,ECI,ECKEY,ECROU,ECSAVE,ECDESC,ECX,DIC,X,Y

 S ECV="ECD0^ECDUZ^ECPTYP" D REQCHK^ECRRPT(ECV) I ECERR Q

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

 . I ECD0="ALL" D  Q

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

 . S ECI=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 ECDSSU(+Y)=$P(Y,U,2)

 I ECPTYP="P" D  Q

 . S ECROU="STRPT^ECRDSSUA"

 . S ECSAVE("ECDSSU(")=""

 . S ECDESC="Users with access to DSS Units"

 . D QUEUE^ECRRPT

 D STRPT^ECRDSSUA

 Q

ALLU ;-- Get all DSS Units and create ECDSSU array

 N ECD,ECN,ECX,Y

 S ECD="",ECN=0

 F  S ECD=$O(^ECD("B",ECD)) Q:ECD=""  F  S ECN=$O(^ECD("B",ECD,ECN)) Q:'ECN  D

 . Q:'$$VALID(ECN)!('ECKEY&('$D(^VA(200,ECDUZ,"EC",+ECN))))

 . S ECDSSU(ECN)=ECD

ALLUQ Q

 ;

VALID(IEN) ;-- Check DSS Unit for use by Event Capture

 N NODE

 S NODE=$G(^ECD(IEN,0))

 Q $S($P(NODE,"^",8):1,1:0)

 ;

ECRUDSS ;List all DSS units user has access to

 ;     Variables passed in

 ;       ECDUZ       - User IEN from file (#200)

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

 ;                     data will be returned in ^TMP($J,"ECRPT") in

 ;                     delimited format for export to spreadsheet

 ;

 ;     Variable return

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

 N ECV,ECROU,ECSAVE,ECDESC

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

 I ECPTYP="P" D  Q

 . S ECROU="STRPT^ECRUDSS"

 . S ECSAVE("ECDUZ")=""

 . S ECDESC="DSS unit access for a selected user"

 . D QUEUE^ECRRPT

 D STRPT^ECRUDSS

 Q

 ;

ECRDSSEC ;List event code screens for selected DSS unit

 ;     Variables passed in

 ;       ECD       - DSS Unit IEN

 ;       STAT      - Event code screen, (A)ctive, (I)nactive,(B)oth

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

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=delimited data

 ;

 ;

 N ECV,ECROU,ECSAVE,ECDESC

 S ECV="ECD^STAT^ECPTYP" D REQCHK^ECRRPT(ECV) I ECERR Q

 I ECPTYP="P" D  Q

 . S ECROU="STRPT^ECRDSSEC"

 . S ECSAVE("ECD")="",ECSAVE("STAT")="",ECSAVE("ECPTYP")=""

 . S ECDESC="Event code screens for selected DSS Unit"

 . D QUEUE^ECRRPT

 D STRPT^ECRDSSEC

 Q

 ;

ECRECER ;Event Capture Encounter Report

 ;     Variables passed in

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

 ;       ECDUZ       - User IEN from file (#200)

 ;       ECL0        - Location IEN (1 or ALL)

 ;       ECSORT      - Sort ordered by (P)atient or (D)octor (provider)

 ;       ECSD        - Start date range

 ;       ECED        - End date range

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

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=returned if exported

 N ECDSSU,ECV,ECI,ECKEY,ECROU,ECSAVE,ECDESC,ECX,DIC,X,Y,ECLOC,ECLOC1

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

 D DATECHK^ECRRPT(.ECSD,.ECED)

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

 . I ECD0="ALL" D  Q

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

 . S ECI=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 ECDSSU(+Y)=$P(Y,U,2)

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

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

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

 I ECPTYP="P" D  Q

 . S ECROU="STRPT^ECRECER"

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

 . S ECDESC="Event Capture Encounter Report"

 . D QUEUE^ECRRPT

 D STRPT^ECRECER

 Q

 ;

ECRECSIC ;Event Capture Report, Event Capture Screen, Inactive Clinics

 ;     Variables passed in

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

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

 ;       ECDUZ       - User IEN from file (#200)

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

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=returned if exported

 N ECDSSU,ECV,ECI,ECKEY,ECROU,ECSAVE,ECDESC,ECX,DIC,X,Y,ECLOC,ECLOC1

 S ECV="ECD0^ECL0^ECDUZ^ECPTYP" D REQCHK^ECRRPT(ECV) I ECERR Q

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

 . I ECD0="ALL" D  Q

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

 . S ECI=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 ECDSSU(+Y)=$P(Y,U,2)

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

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

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

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

 I ECPTYP="P" D  Q

 . S ECROU="STRPT^ECRECSIC"

 . S ECSAVE("ECDSSU(")=""

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

 . S ECDESC="Event Capture Event Code Screens with Inactive Clinics"

 . D QUEUE^ECRRPT

 D STRPT^ECRECSIC

 Q

 ;

ECRECSPC ;Event code screens by procedure code

 ;     Variables passed in

 ;       ECLPC0...n  - Procedure Code (1, some or ALL)

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

 ;       ECDUZ       - User IEN from file (#200)

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

 ;

 ;     Variable return

 ;       ^TMP($J,"ECRPT",n)=returned if exported

 N ECV,ECI,ECKEY,ECROU,ECSAVE,ECDESC,ECX,DIC,X,Y,ECPROC,ECLOC,ECLOC1

 S ECV="ECLPC0^ECL0^ECDUZ^ECPTYP" D REQCHK^ECRRPT(ECV) I ECERR Q

 D  I '$D(ECPROC)&(ECLPC0'="ALL") S ^TMP("ECMSG",$J)="1^Invalid Procedure Code." Q

 . I ECLPC0="ALL" Q

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

 . . S ECPROC(@ECX)=""

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

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

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

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

 I ECPTYP="P" D  Q

 . S ECROU="STRPT^ECRECSPC"

 . S ECSAVE("ECPROC(")=""

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

 . S ECDESC="Event Capture Event Code Screens by procedure code"

 . D QUEUE^ECRRPT

 D STRPT^ECRECSPC

 Q

ECRGP ;generic print capability

 ;  Variables passed in

 ;  ECLIN0...n  - Lines of data to be printed out

 ;

 ;  Variables returned - none

 ;

 N ECROU,ECSAVE,ECDESC,ECX,I,ECV

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

 S ECROU="PRINT^ECRRPT2"

 S ECDESC="Generic Print of Event Capture Report"

 F I=0:1 S ECX="ECLIN"_I Q:'$D(@ECX)  S ECSAVE(ECX)=""

 D QUEUE^ECRRPT

 Q

 ;

PRINT ;Send data to printer

 N I,ECX

 U IO

 W @IOF

 F I=0:1 S ECX="ECLIN"_I Q:'$D(@ECX)  W !,@ECX I $Y>(IOSL-4) W @IOF

 Q

 ;

ECDSSSNR ;131 DSS units set to send no records to PCE

 ;     Variables passed in

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

 ;                     data will be returned in ^TMP($J,"ECRPT") in

 ;                     delimited format for export to spreadsheet

 ;

 ;     Variable return

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

 N ECV,ECROU,ECDESC

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

 I ECPTYP="P" D  Q

 . S ECROU="START^ECDSSSNR"

 . S ECDESC="DSS Units set to send no records to PCE"

 . D QUEUE^ECRRPT

 D START^ECDSSSNR

 Q

 ;

ECDISSUM ;131 Disabled Category and Procedure Summary Report

 ;     Variables passed in

 ;       ECL0..n  - Location to report (1,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,ECLOC,I,LIEN,ECSAVE,ECDESC,ECROU

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

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

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

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

 I ECPTYP="P" D  Q

 . S ECV="ECL0^ECPTYP",ECROU="EN^ECDISSUM"

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

 . S ECDESC="EC Disabled Category Report"

 . D QUEUE^ECRRPT

 D EN^ECDISSUM

 Q

 ;

ECLATESH ;139 Possible Late State Home Entries Report

 ;     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

 ;

 ;     Variable return

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

 N ECV,ECDATE,ECROU,ECDESC

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

 D DATECHK^ECRRPT(.ECSD,.ECED)

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

 I ECPTYP="P" D  Q

 . S ECV="ECSD^ECED^ECDATE",ECROU="START^ECLATESH"

 . S ECDESC="Possible Late State Home Entries Report"

 . D QUEUE^ECRRPT

 D START^ECLATESH

 Q

 ;

ECRPROC ;156 - Procedure Used Report

 ;     Variables passed in

 ;       ECPROC - IEN of the Procedure Code for file #81 or #725:100217;ICPT(^B4154  EF SPEC METABOLIC NONINHERIT"/3291;EC(725,^NU079  NUTR GP, 11-20 PT 1ST 30M

 ;       ECU    - All or single IEN for file 200

 ;       ECL0   - All, 1, or many locations

 ;       ECD0   - All, 1, or many DSS units

 ;       ECSD   - Start Date or Report

 ;       ECED   - End Date or Report

 ;       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,ECUN,ECROU,ECDESC,DIC,X,Y,ECSAVE,ECPROC,ECLOC,ECDSSU,NUM

 N ECNT,ECI,ECX

 S ECV="ECU^ECLPC0^ECSD^ECED^ECL0^ECD0^ECPTYP" D REQCHK^ECRRPT(ECV) I ECERR Q

 I ECU="ALL" S ECUN="ALL"

 I ECU'="ALL" S DIC=200,DIC(0)="QNZX",X=ECU D ^DIC D:Y<0  Q:Y<0  S ECUN=$P(Y,U,2)

 . S ^TMP("ECMSG",$J)="1^Invalid Provider."

 D DATECHK^ECRRPT(.ECSD,.ECED)

 D  I '$D(ECPROC)&(ECLPC0'="ALL") S ^TMP("ECMSG",$J)="1^Invalid Procedure Code." Q

 . I ECLPC0="ALL" Q

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

 . . S ECPROC(@ECX)=""

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

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

 . S ECNT=0,DIC=4,DIC(0)="QNZX" F I=0:1 S LIEN=$G(@("ECL"_I)) Q:'+LIEN  D

 .. S X=LIEN D ^DIC Q:Y<0

 .. S ECNT=ECNT+1,ECLOC(ECNT)=+Y_"^"_$P(Y,U,2)

 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

 I ECPTYP="P" D  Q

 . S ECV="ECU^ECUN^ECLPC0^ECSD^ECED^ECDATE^ECL0^ECD0^ECPTYP"

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

 . S ECROU="EN^ECRPROC",ECDESC="Event Capture Procedure Used Report"

 . D QUEUE^ECRRPT

 D EN^ECRPROC

 Q

 ;

ECREDIT ;159 - Edit Log Report

 ;     Variables passed in

 ;       ECL    - Location to report (1 or ALL)

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

 ;       ECSORT - Sort type(D or U)

 ;       ECSD   - Start Date or Report

 ;       ECED   - End Date or Report

 ;       ECDUZ  - User IEN from file (#200)

 ;       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 ECDATE,ECDSSU,ECV,ECI,ECNT,ECKEY,ECROU,ECSAVE,ECDESC,ECX,DIC,X,Y,ECLOC,ECLOC1,LIEN

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

 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

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

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

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

 D DATECHK^ECRRPT(.ECSD,.ECED)

 I ECPTYP="P" D  Q

 . S ECROU="EN^ECREDIT",ECV="ECSORT^ECSD^ECED^ECPTYP"

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

 . S ECDESC="Event Capture Edit Log Report"

 . D QUEUE^ECRRPT

 D EN^ECREDIT

 Q

 ;

ECCLIPRO ;159 - Procedure by Clinic Report

 N ECDATE,ECDSSU,ECV,ECI,ECNT,ECKEY,ECROU,ECSAVE,ECDESC,ECX,DIC,X,Y,ECLOC,ECCLIN

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

 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

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

 . S X=ECL0,DIC=4,DIC(0)="QNZX" D ^DIC Q:Y<0  S ECLOC=ECL0

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

 . S X=ECCLI,DIC=44,DIC(0)="QNZX",DIC("S")="I $P(^(0),U,3)=""C"""

 . D ^DIC Q:Y<0  S ECCLIN=ECCLI

 D DATECHK^ECRRPT(.ECSD,.ECED)

  I ECPTYP="P" D  Q

 . S ECROU="EN^ECCLIPRO",ECV="ECLOC^ECCLI^ECSORT^ECSD^ECED^ECPTYP"

 . S ECSAVE("ECDSSU(")=""

 . S ECDESC="Event Capture Procedure by Clinic Report"

 . D QUEUE^ECRRPT

 D EN^ECCLIPRO

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECRRPT2   14163     printed  Mar 13, 2025@21:03:36                                                                                                                                                                                                    Page 2

ECRRPT2   ;ALB/DAN - Event Capture Report RPC Broker (Cont) ;Nov 16, 2022@13:46:43

 +1       ;;2.0;EVENT CAPTURE;**112,131,139,156,159**;8 May 96;Build 61

 +2       ;

 +3       ; Reference to ^TMP supported by SACC 2.3.2.5.1

 +4       ; Reference to ^XUSEC(KEY) in ICR #10076

 +5       ; Reference to ^DIC in ICR #10006

 +6       ; Reference to ^VA(200, in ICR #10060

 +7       ;

ECRDSSUA  ;List users with access to DSS Units

 +1       ;     Variables passed in

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

 +3       ;       ECDUZ       - User IEN from file (#200)

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

 +5       ;                     data will be returned in ^TMP($J,"ECRPT") in

 +6       ;                     delimited format for export to spreadsheet

 +7       ;

 +8       ;     Variable return

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

 +10       NEW ECDSSU,ECV,ECI,ECKEY,ECROU,ECSAVE,ECDESC,ECX,DIC,X,Y

 +11       SET ECV="ECD0^ECDUZ^ECPTYP"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +12       Begin DoDot:1

 +13           IF ECD0="ALL"

                   Begin DoDot:2

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

                       DO ALLU

                   End DoDot:2

                   QUIT 

 +15           SET ECI=0

               FOR ECI=0:1

                   SET ECX="ECD"_ECI

                   if '$DATA(@ECX)

                       QUIT 

                   Begin DoDot:2

 +16                   KILL DIC

                       SET DIC=724

                       SET DIC(0)="QNZX"

                       SET X=@ECX

                       DO ^DIC

                       IF Y<0

                           QUIT 

 +17                   SET ECDSSU(+Y)=$PIECE(Y,U,2)

                   End DoDot:2

           End DoDot:1

           IF '$DATA(ECDSSU)

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

               QUIT 

 +18       IF ECPTYP="P"

               Begin DoDot:1

 +19               SET ECROU="STRPT^ECRDSSUA"

 +20               SET ECSAVE("ECDSSU(")=""

 +21               SET ECDESC="Users with access to DSS Units"

 +22               DO QUEUE^ECRRPT

               End DoDot:1

               QUIT 

 +23       DO STRPT^ECRDSSUA

 +24       QUIT 

ALLU      ;-- Get all DSS Units and create ECDSSU array

 +1        NEW ECD,ECN,ECX,Y

 +2        SET ECD=""

           SET ECN=0

 +3        FOR 

               SET ECD=$ORDER(^ECD("B",ECD))

               if ECD=""

                   QUIT 

               FOR 

                   SET ECN=$ORDER(^ECD("B",ECD,ECN))

                   if 'ECN

                       QUIT 

                   Begin DoDot:1

 +4                    if '$$VALID(ECN)!('ECKEY&('$DATA(^VA(200,ECDUZ,"EC",+ECN))))

                           QUIT 

 +5                    SET ECDSSU(ECN)=ECD

                   End DoDot:1

ALLUQ      QUIT 

 +1       ;

VALID(IEN) ;-- Check DSS Unit for use by Event Capture

 +1        NEW NODE

 +2        SET NODE=$GET(^ECD(IEN,0))

 +3        QUIT $SELECT($PIECE(NODE,"^",8):1,1:0)

 +4       ;

ECRUDSS   ;List all DSS units user has access to

 +1       ;     Variables passed in

 +2       ;       ECDUZ       - User IEN from file (#200)

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

 +4       ;                     data will be returned in ^TMP($J,"ECRPT") in

 +5       ;                     delimited format for export to spreadsheet

 +6       ;

 +7       ;     Variable return

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

 +9        NEW ECV,ECROU,ECSAVE,ECDESC

 +10       SET ECV="ECDUZ^ECPTYP"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +11       IF ECPTYP="P"

               Begin DoDot:1

 +12               SET ECROU="STRPT^ECRUDSS"

 +13               SET ECSAVE("ECDUZ")=""

 +14               SET ECDESC="DSS unit access for a selected user"

 +15               DO QUEUE^ECRRPT

               End DoDot:1

               QUIT 

 +16       DO STRPT^ECRUDSS

 +17       QUIT 

 +18      ;

ECRDSSEC  ;List event code screens for selected DSS unit

 +1       ;     Variables passed in

 +2       ;       ECD       - DSS Unit IEN

 +3       ;       STAT      - Event code screen, (A)ctive, (I)nactive,(B)oth

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

 +5       ;

 +6       ;     Variable return

 +7       ;       ^TMP($J,"ECRPT",n)=delimited data

 +8       ;

 +9       ;

 +10       NEW ECV,ECROU,ECSAVE,ECDESC

 +11       SET ECV="ECD^STAT^ECPTYP"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +12       IF ECPTYP="P"

               Begin DoDot:1

 +13               SET ECROU="STRPT^ECRDSSEC"

 +14               SET ECSAVE("ECD")=""

                   SET ECSAVE("STAT")=""

                   SET ECSAVE("ECPTYP")=""

 +15               SET ECDESC="Event code screens for selected DSS Unit"

 +16               DO QUEUE^ECRRPT

               End DoDot:1

               QUIT 

 +17       DO STRPT^ECRDSSEC

 +18       QUIT 

 +19      ;

ECRECER   ;Event Capture Encounter Report

 +1       ;     Variables passed in

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

 +3       ;       ECDUZ       - User IEN from file (#200)

 +4       ;       ECL0        - Location IEN (1 or ALL)

 +5       ;       ECSORT      - Sort ordered by (P)atient or (D)octor (provider)

 +6       ;       ECSD        - Start date range

 +7       ;       ECED        - End date range

 +8       ;       ECPTYP      - Where to send output (P)rinter, (D)evice (screen), (E)xport

 +9       ;

 +10      ;     Variable return

 +11      ;       ^TMP($J,"ECRPT",n)=returned if exported

 +12       NEW ECDSSU,ECV,ECI,ECKEY,ECROU,ECSAVE,ECDESC,ECX,DIC,X,Y,ECLOC,ECLOC1

 +13       SET ECV="ECD0^ECDUZ^ECL0^ECSORT^ECSD^ECED^ECPTYP"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

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

 +15       Begin DoDot:1

 +16           IF ECD0="ALL"

                   Begin DoDot:2

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

                       DO ALLU

                   End DoDot:2

                   QUIT 

 +18           SET ECI=0

               FOR ECI=0:1

                   SET ECX="ECD"_ECI

                   if '$DATA(@ECX)

                       QUIT 

                   Begin DoDot:2

 +19                   KILL DIC

                       SET DIC=724

                       SET DIC(0)="QNZX"

                       SET X=@ECX

                       DO ^DIC

                       IF Y<0

                           QUIT 

 +20                   SET ECDSSU(+Y)=$PIECE(Y,U,2)

                   End DoDot:2

           End DoDot:1

           IF '$DATA(ECDSSU)

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

               QUIT 

 +21       Begin DoDot:1

 +22           IF ECL0="ALL"

                   DO LOCARRY^ECRUTL

                   QUIT 

 +23           SET DIC=4

               SET DIC(0)="QNZX"

               SET X=ECL0

               DO ^DIC

               if Y<0

                   QUIT 

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

               SET ECLOC1(+Y)=$PIECE(Y,U,2)

           End DoDot:1

           IF '$DATA(ECLOC)

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

               QUIT 

 +24       IF ECPTYP="P"

               Begin DoDot:1

 +25               SET ECROU="STRPT^ECRECER"

 +26               SET ECSAVE("ECDSSU(")=""

                   SET ECSAVE("ECLOC(")=""

                   SET ECSAVE("ECLOC1(")=""

 +27               SET ECDESC="Event Capture Encounter Report"

 +28               DO QUEUE^ECRRPT

               End DoDot:1

               QUIT 

 +29       DO STRPT^ECRECER

 +30       QUIT 

 +31      ;

ECRECSIC  ;Event Capture Report, Event Capture Screen, Inactive Clinics

 +1       ;     Variables passed in

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

 +3       ;       ECL0...n    - Location IEN (1,some or ALL)

 +4       ;       ECDUZ       - User IEN from file (#200)

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

 +6       ;

 +7       ;     Variable return

 +8       ;       ^TMP($J,"ECRPT",n)=returned if exported

 +9        NEW ECDSSU,ECV,ECI,ECKEY,ECROU,ECSAVE,ECDESC,ECX,DIC,X,Y,ECLOC,ECLOC1

 +10       SET ECV="ECD0^ECL0^ECDUZ^ECPTYP"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +11       Begin DoDot:1

 +12           IF ECD0="ALL"

                   Begin DoDot:2

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

                       DO ALLU

                   End DoDot:2

                   QUIT 

 +14           SET ECI=0

               FOR ECI=0:1

                   SET ECX="ECD"_ECI

                   if '$DATA(@ECX)

                       QUIT 

                   Begin DoDot:2

 +15                   KILL DIC

                       SET DIC=724

                       SET DIC(0)="QNZX"

                       SET X=@ECX

                       DO ^DIC

                       IF Y<0

                           QUIT 

 +16                   SET ECDSSU(+Y)=$PIECE(Y,U,2)

                   End DoDot:2

           End DoDot:1

           IF '$DATA(ECDSSU)

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

               QUIT 

 +17       Begin DoDot:1

 +18           IF ECL0="ALL"

                   DO LOCARRY^ECRUTL

                   QUIT 

 +19           SET ECI=0

               FOR ECI=0:1

                   SET ECX="ECL"_ECI

                   if '$DATA(@ECX)

                       QUIT 

                   Begin DoDot:2

 +20                   SET DIC=4

                       SET DIC(0)="QNZX"

                       SET X=@ECX

                       DO ^DIC

                       if Y<0

                           QUIT 

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

                       SET ECLOC1(+Y)=$PIECE(Y,U,2)

                   End DoDot:2

           End DoDot:1

           IF '$DATA(ECLOC)

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

               QUIT 

 +21       IF ECPTYP="P"

               Begin DoDot:1

 +22               SET ECROU="STRPT^ECRECSIC"

 +23               SET ECSAVE("ECDSSU(")=""

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

                   SET ECSAVE("ECLOC1(")=""

 +25               SET ECDESC="Event Capture Event Code Screens with Inactive Clinics"

 +26               DO QUEUE^ECRRPT

               End DoDot:1

               QUIT 

 +27       DO STRPT^ECRECSIC

 +28       QUIT 

 +29      ;

ECRECSPC  ;Event code screens by procedure code

 +1       ;     Variables passed in

 +2       ;       ECLPC0...n  - Procedure Code (1, some or ALL)

 +3       ;       ECL0...n    - Location IEN (1,some or ALL)

 +4       ;       ECDUZ       - User IEN from file (#200)

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

 +6       ;

 +7       ;     Variable return

 +8       ;       ^TMP($J,"ECRPT",n)=returned if exported

 +9        NEW ECV,ECI,ECKEY,ECROU,ECSAVE,ECDESC,ECX,DIC,X,Y,ECPROC,ECLOC,ECLOC1

 +10       SET ECV="ECLPC0^ECL0^ECDUZ^ECPTYP"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +11       Begin DoDot:1

 +12           IF ECLPC0="ALL"

                   QUIT 

 +13           SET ECI=0

               FOR ECI=0:1

                   SET ECX="ECLPC"_ECI

                   if '$DATA(@ECX)

                       QUIT 

                   Begin DoDot:2

 +14                   SET ECPROC(@ECX)=""

                   End DoDot:2

           End DoDot:1

           IF '$DATA(ECPROC)&(ECLPC0'="ALL")

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

               QUIT 

 +15       Begin DoDot:1

 +16           IF ECL0="ALL"

                   DO LOCARRY^ECRUTL

                   QUIT 

 +17           SET ECI=0

               FOR ECI=0:1

                   SET ECX="ECL"_ECI

                   if '$DATA(@ECX)

                       QUIT 

                   Begin DoDot:2

 +18                   SET DIC=4

                       SET DIC(0)="QNZX"

                       SET X=@ECX

                       DO ^DIC

                       if Y<0

                           QUIT 

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

                       SET ECLOC1(+Y)=$PIECE(Y,U,2)

                   End DoDot:2

           End DoDot:1

           IF '$DATA(ECLOC)

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

               QUIT 

 +19       IF ECPTYP="P"

               Begin DoDot:1

 +20               SET ECROU="STRPT^ECRECSPC"

 +21               SET ECSAVE("ECPROC(")=""

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

                   SET ECSAVE("ECLOC1(")=""

 +23               SET ECDESC="Event Capture Event Code Screens by procedure code"

 +24               DO QUEUE^ECRRPT

               End DoDot:1

               QUIT 

 +25       DO STRPT^ECRECSPC

 +26       QUIT 

ECRGP     ;generic print capability

 +1       ;  Variables passed in

 +2       ;  ECLIN0...n  - Lines of data to be printed out

 +3       ;

 +4       ;  Variables returned - none

 +5       ;

 +6        NEW ECROU,ECSAVE,ECDESC,ECX,I,ECV

 +7        SET ECV="ECLIN0"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +8        SET ECROU="PRINT^ECRRPT2"

 +9        SET ECDESC="Generic Print of Event Capture Report"

 +10       FOR I=0:1

               SET ECX="ECLIN"_I

               if '$DATA(@ECX)

                   QUIT 

               SET ECSAVE(ECX)=""

 +11       DO QUEUE^ECRRPT

 +12       QUIT 

 +13      ;

PRINT     ;Send data to printer

 +1        NEW I,ECX

 +2        USE IO

 +3        WRITE @IOF

 +4        FOR I=0:1

               SET ECX="ECLIN"_I

               if '$DATA(@ECX)

                   QUIT 

               WRITE !,@ECX

               IF $Y>(IOSL-4)

                   WRITE @IOF

 +5        QUIT 

 +6       ;

ECDSSSNR  ;131 DSS units set to send no records to PCE

 +1       ;     Variables passed in

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

 +3       ;                     data will be returned in ^TMP($J,"ECRPT") in

 +4       ;                     delimited format for export to spreadsheet

 +5       ;

 +6       ;     Variable return

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

 +8        NEW ECV,ECROU,ECDESC

 +9        SET ECV="ECPTYP"

           DO REQCHK^ECRRPT(ECV)

           IF ECERR

               QUIT 

 +10       IF ECPTYP="P"

               Begin DoDot:1

 +11               SET ECROU="START^ECDSSSNR"

 +12               SET ECDESC="DSS Units set to send no records to PCE"