ECRRPT1 ;ALB/JAM;Event Capture Report RPC Broker ;10-31,2006
 ;;2.0; EVENT CAPTURE ;**25,32,33,61,78,72,90**;8 May 96;Build 1
 ;
ECRPRSN ;Procedure Reason Report for RPC Call
 ;     Variables passed in
 ;       ECSD     - Start Date or Report
 ;       ECED     - End Date or Report
 ;       ECL      - Location to report (1 or ALL)
 ;       ECD0..n  - DSS Unit to report (1,some or ALL)
 ;       ECRY0..n - Procedure reason (some or ALL)
 ;
 ;     Variable return
 ;       ^TMP($J,"ECRPT",n)=report output or to print device.
 N ECV,ECI,ECLOC,ECDSSU,ECDN,ECDATE,ECUN,ECNT,ECKEY,ECX,DUZ,ECLINK,ECZ
 N ECROU,ECSAVE,ECDESC,ECW,DIC,X,Y
 S ECV="ECL^ECD0^ECSD^ECED^ECRY0" 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)="QNMZX",X=ECL D ^DIC Q:Y<0  S ECLOC(1)=+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),DUZ=ECDUZ 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)="QNMZX",X=@ECX D ^DIC I Y<0 Q
 . . 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",ECROU="START^ECRPRSN"
 . S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("),ECSAVE("ECLINK("))=""
 . S ECDESC="EC Procedure Reason Report"
 . D QUEUE^ECRRPT
 D START^ECRPRSN,EXIT^ECRPRSN
 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)
 ;
 ;     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)
 ;    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 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"
 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)
 ;
 ;     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 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"
 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)
 ;       ECD      - DSS Unit to report (1 or ALL), If ECD'="ALL" then ECC
 ;       ECC      - Category (1 or ALL) (optional)
 ;       ECRTN    - Event Code Screen (Active, Inactive or Both)
 ;
 ;     Variable return
 ;       ^TMP($J,"ECRPT",n)=report output or to print device.
 N ECV,ECDN,ECCN,ECROU,ECSAVE,ECDESC,ECLN,ECS,ECJLP,ECSN,ECALL,DIC,X,Y
 N ECSCN
 S (ECJLP,ECALL)=0,ECV="ECL^ECD^ECRTN" D REQCHK^ECRRPT(ECV) I ECERR Q
 S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC D:Y<0  Q:ECERR  S ECLN=$P(Y,U,2)
 . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
 S ECSCN=ECRTN 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)="QNMZX",X=ECD D ^DIC I Y<0 S ECERR=1 Q
 . S ECDN=$P(Y,U,2)_$S($P($G(^ECD(+ECD,0)),"^",6):" **Inactive**",1:"")
 . S ECS=+$P(^ECD(ECD,0),"^",2),ECJLP=+$P(^(0),"^",11)
 . S ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
 . I 'ECJLP S ECC=0,ECCN="None"
 I ECALL D PXRUN 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)
PXRUN I ECPTYP="P" D  Q
 . S ECV="ECL^ECLN^ECALL^ECSCN",ECROU="START^ECSUM"
 . I 'ECALL S ECV=ECV_"^ECD^ECC^ECLN^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
 ;
 ;     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^ECNTPCE"
 . 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)
 ;       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)
 ;
 ;     Variable return
 ;       ^TMP($J,"ECRPT",n)=report output or to print device.
 N ECV,ECDN,ECCN,ECROU,ECSAVE,ECDESC,ECLN,ECS,ECJLP,ECALL,DIC,X,Y
 S (ECJLP,ECALL)=0,ECV="ECL^ECD^ECCPT" D REQCHK^ECRRPT(ECV) I ECERR Q
 S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC D:Y<0  Q:ECERR  S ECLN=$P(Y,U,2)
 . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
 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)="QNMZX",X=ECD D ^DIC I Y<0 S ECERR=1 Q
 . 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="ECL^ECLN^ECALL^ECCPT",ECROU="START^ECSCPT"
 . 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
 ;       NONE     - No input variables
 ;
 ;     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="START^ECINCPT",ECV="ECL",ECL=""
 . S ECDESC="National/Local Procedure Codes with Inactive CPT"
 . D QUEUE^ECRRPT
 U IO D START^ECINCPT
 Q