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 ---[H[J[2J[HECRRPT1 12096 printed Dec 13, 2024@01:58:45 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)
+21 IF 'ECJLP
SET ECC=0
SET ECCN="None"
End DoDot:1
IF ECERR
SET ^TMP("ECMSG",$JOB)="1^Invalid DSS Unit."
QUIT
+22 IF ECALL
DO CPTRUN
QUIT
+23 SET ECV="ECC"
DO REQCHK^ECRRPT(ECV)
IF ECERR
QUIT
+24 Begin DoDot:1
+25 IF (ECC="ALL")!(ECC=0)
QUIT
+26 KILL DIC
SET DIC=726
SET DIC(0)="QNMZX"
SET X=ECC
DO ^DIC
IF Y<0
SET ECERR=1
QUIT
+27 SET ECCN=$PIECE(Y,U,2)
End DoDot:1
IF ECERR
SET ^TMP("ECMSG",$JOB)="1^Invalid Category."
QUIT
CPTRUN IF ECPTYP="P"
Begin DoDot:1
+1 SET ECV="ECALL^ECCPT"
SET ECROU="START^ECSCPT"
+2 SET ECSAVE("ECLOC(")=""
+3 IF 'ECALL
SET ECV=ECV_"^ECD^ECC^ECDN^ECJLP^ECCN"
+4 SET ECDESC="Event Code Screens with CPT Codes"
+5 DO QUEUE^ECRRPT
End DoDot:1
QUIT
+6 USE IO
DO START^ECSCPT
+7 QUIT
ECINCPT ;National/Local Procedure Codes with Inactive CPT Reports for RPC Call
+1 ; Variables passed in
+2 ; ECPTYP - Where to send output (P)rinter, (D)evice or screen
+3 ; or (E)xport
+4 ; 152 - Adding the next three variables
+5 ; ECRN - Preferred Report (N-ational, L-ocal or Both)
+6 ; ECSM - Sort Method (P-rocedure Name, N-ational Number,C-PT Code,D-Inactive Date)
+7 ; ECSORT - Sort Order "A"scending, "D"escending
+8 ;
+9 ; Variable return
+10 ; ^TMP($J,"ECRPT",n)=report output or to print device.
+11 NEW ECV,ECL,ECDESC,ECROU,DQTIME,ECPG
+12 ;152
SET ECV="ECRN^ECSM^ECSORT"
DO REQCHK^ECRRPT(ECV)
IF ECERR
QUIT
+13 SET ECPG=1
+14 IF ECPTYP="P"
Begin DoDot:1
+15 ;152 ,ECV="ECL",ECL=""
SET ECV="ECRN^ECSM^ECSORT"
SET ECROU="START^ECINCPT"
+16 SET ECDESC="National/Local Procedure Codes with Inactive CPT"
+17 DO QUEUE^ECRRPT
End DoDot:1
QUIT
+18 USE IO
DO START^ECINCPT
+19 QUIT
ECGTP ;ECS Generic Table Printer
+1 ; Variables passed in
+2 ; ECOBHNDL - Handle to generic table print obj
+3 ; ECPTYP - Where to send output (P)rinter, (D)evice or screen
+4 ;
+5 ; Variable return
+6 ; ^TMP($J,"ECRPT",n)=report output or to print device.
+7 NEW ECV,ECROU,ECDESC
+8 SET ECV="ECOBHNDL"
DO REQCHK^ECRRPT(ECV)
IF ECERR
QUIT
+9 IF ECPTYP="P"
Begin DoDot:1
+10 SET ECV="ECOBHNDL"
SET ECROU="START^ECGTP"
+11 SET ECDESC="ECS Generic Table Printer"
+12 DO QUEUE^ECRRPT
End DoDot:1
QUIT
+13 DO START^ECGTP
+14 QUIT
ECSTPCD ;DSS Units with Associated Stop Code Error REPORT
+1 ; EC*2*107 - added to GUI reports
+2 ; Variables passed in
+3 ; ECPTYP - Where to send output (P)rinter, (D)evice or screen
+4 ; or (E)xport
+5 ;
+6 ; Variable return
+7 ; ^TMP($J,"ECRPT",n)=report output or to print device.
+8 NEW ECV,ECL,ECDESC,ECROU,DQTIME,ECPG
+9 SET ECPG=1
+10 IF ECPTYP="P"
Begin DoDot:1
+11 SET ECROU="STRTGUI^ECUNTRPT"
SET ECV="ECL"
SET ECL=""
+12 SET ECDESC="DSS Units with Associated Stop Code Error"
+13 DO QUEUE^ECRRPT
End DoDot:1
QUIT
+14 USE IO
DO STRTGUI^ECUNTRPT
+15 QUIT
