ECRRPT ;ALB/JAM - Event Capture Report RPC Broker ;10/22/18 15:17
;;2.0;EVENT CAPTURE;**25,32,41,56,61,82,94,95,108,112,119,122,126,145**;8 May 96;Build 6
;
;119 For patch 119, added comment regarding ECPTYP being set to "E" when exporting, for those reports that are now exportable.
REQCHK(ECV) ;Required data check
N I,C
S C=1
F I=1:1:$L(ECV,U) I '$D(@$P(ECV,U,I)) D
. S ^TMP("ECMSG",$J,C)="0^Required data missing "_$P(ECV,U,I)
. S C=C+1,ECERR=1
Q
DATECHK(ECSD,ECED) ;Check human format date and converts to FileMan format
; Input ECSD - Start Date (ex. 10/9/01)
; ECED - End Date
N ECI,X,Y
S %DT="X" F ECI="ECSD","ECED" S X=@ECI D ^%DT S @ECI=Y
S ECSD=$S(ECSD=-1:DT,1:ECSD),ECED=$S(ECED=-1:DT,1:ECED)
S ECDATE=$$FMTE^XLFDT(ECSD)_"^"_$$FMTE^XLFDT(ECED)
Q
QUEUE ;Queues report to printer
N ZTIO,ZTDESC,ZTRTN,ZTDTH,ZTSAVE,%ZIS,I,IOP,POP
S IOP="Q;`"_ECDEV,%ZIS="Q" D ^%ZIS I POP D Q
. S ^TMP("ECMSG",$J,1)="0^Device selection unsuccessful"
S ZTIO=ION,ZTDESC=ECDESC,ZTRTN=ECROU
S ZTDTH=$$FMTH^XLFDT(ECQDT)
;D NOW^%DTC S ZTDTH=$S(%'<ECQDT:%+.0002,1:ECQDT)
F I=1:1:$L(ECV,U) I $D(@$P(ECV,U,I)) S ZTSAVE($P(ECV,U,I))=""
M ZTSAVE=ECSAVE
D ^%ZTLOAD,HOME^%ZIS,^%ZISC ;K IO("Q")
I $D(ZTSK) S ^TMP("ECMSG",$J)="1^Report queued. Task #"_ZTSK Q
S ^TMP("ECMSG",$J)="0^Task Rejected"
Q
;
ECPAT ;Patient Summary Report for RPC Call
; Variables passed in
; ECDFN - Patient IEN for file #2
; ECSD - Start Date or Report
; ECED - End Date or Report
; ECRY - Print Procedure Reason (optional)
; 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,ECPAT,ECV,DIC,X,Y,ECROU,ECDESC
S ECV="ECDFN^ECSD^ECED" D REQCHK(ECV) I ECERR Q
S DIC=2,DIC(0)="QNMZX",X=ECDFN D ^DIC Q:Y<0 S ECPAT=$P(Y,U,2)
;EC*2.0*108 - Convert Date/Time to Date only
S ECSD=$P(ECSD,"."),ECED=$P(ECED,".")
D DATECHK(.ECSD,.ECED)
S ECSD=ECSD-.0001,ECED=ECED+.9999
I $E($G(ECRY))'="Y" K ECRY
I ECPTYP="P" D Q
. S ECV="ECDFN^ECPAT^ECDATE^ECSD^ECED^ECRY",ECROU="SUM^ECPAT"
. S ECDESC="EVENT CAPTURE PATIENT SUMMARY"
. D QUEUE
D SUM^ECPAT
Q
ECRDSSU ;DSS Unit Workload Summary Report
; Variables passed in
; ECL - Location to report (1 or ALL)
; ECD - DSS Unit to report (1, some or ALL)
; 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 ECLOC,ECDSSU,ECV,ECI,ECSTDT,ECENDDT,ECKEY,ECROU,ECSAVE,ECDESC,ECNT
N ECDATE,ECX,DIC,X,Y
S ECV="ECL^ECD0^ECSD^ECED^ECDUZ" D REQCHK(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_"^"_$P(Y,U,2)
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^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 DATECHK(.ECSD,.ECED)
S ECSTDT=ECSD-.0001,ECENDDT=ECED+.9999
I ECPTYP="P" D Q
. S ECV="ECDATE^ECSTDT^ECENDDT",ECROU="STRPT^ECRDSSU"
. S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
. S ECDESC="DSS UNIT WORKLOAD SUMMARY REPORT"
. D QUEUE
D STRPT^ECRDSSU
Q
PROSUM ;Provider (1-7) Summary Report for RPC Call 119-Updated comment to reflect 7 instead of 3
; Variables passed in
; ECU - Provider 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
; ECRY - Print Procedure Reason (optional)
; 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,ECSLOC,ECSUNIT,NUM ;126
S ECV="ECU^ECSD^ECED^ECL0^ECD0" D REQCHK(ECV) I ECERR Q ;126
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(.ECSD,.ECED)
I ECL0="ALL" S ECSLOC="ALL" ;126
I ECL0'="ALL" F NUM=0:1 Q:'$D(@("ECL"_NUM)) S ECSLOC(@("ECL"_NUM))="" ;126
I ECD0="ALL" S ECSUNIT="ALL" ;126
I ECD0'="ALL" F NUM=0:1 Q:'$D(@("ECD"_NUM)) S ECSUNIT(@("ECD"_NUM))="" ;126
I ECRY'="Y" K ECRY
I ECPTYP="P" D Q
. S ECV="ECU^ECUN^ECDATE^ECSD^ECED^ECRY"
. S ECSAVE("ECSLOC*")="",ECSAVE("ECSUNIT*")="" ;126
. S ECROU="EN^ECPRSUM1",ECDESC="Event Capture Provider Summary"
. D QUEUE
D EN^ECPRSUM1
Q
ECPROV ;Provider Summary Report for RPC Call
; Variables passed in
; ECL - Location to report (1 or ALL)
; ECD - DSS Unit to report (1 or ALL)
; ECSD - Start Date or Report
; ECED - End Date or Report
; ECRY - Print Procedure Reason (optional)
; ECDUZ - User DUZ (ien in #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 ECV,ECDN,ECDATE,ECLN,ECSAVE,ECDESC,ECROU,DIC,X,Y,CNT,UNIT
S ECDN="ALL",ECV="ECL^ECD^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
I ECL'="ALL" D I ECERR Q
. ;The line below was changed by VMP for NOIS ANN-1003-42305
. S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC D:Y<0 Q:Y<0 S ECLN=$P(Y,U,2)
. . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
I ECD'="ALL" K DIC D I ECERR Q
. S DIC=724,DIC(0)="QNZX",X=ECD D ^DIC D:Y<0 Q:Y<0 S ECDN=$P(Y,U,2) ;145
. . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
I ECD="ALL",'$D(^XUSEC("ECALLU",ECDUZ)) D
. S (ECD,ECDN)="SOME",(X,CNT)=0
. F S X=$O(^VA(200,ECDUZ,"EC",X)) Q:'X D
. . S CNT=CNT+1,UNIT=$P(^VA(200,ECDUZ,"EC",X,0),"^")
. . S UNIT(CNT)=UNIT_"^"_$P(^ECD(UNIT,0),"^")
;I $E($G(ECRY))'="Y" K ECRY ;112 Removed check for ECRY as reasons always print - remove comment and next line to restore reason check
S ECRY="Y" ;112 Reasons always print
D DATECHK(.ECSD,.ECED)
S ECSD=ECSD-.0001,ECED=ECED+.9999 S:'$D(UNIT) UNIT=""
I ECPTYP="P" D Q
. S ECV="ECDATE^ECSD^ECED^ECRY",ECROU="START^ECPROV2"
. S (ECSAVE("ECL*"),ECSAVE("ECD*"),ECSAVE("UNIT*"))=""
. S ECDESC="EVENT CAPTURE PROVIDER SUMMARY"
. D QUEUE
U IO D START^ECPROV2
Q
ECOSSUM ;Ordering Section Summary Report for RPC Call
; Variables passed in
; ECOS - Ordering Section
; ECSD - Start Date or Report
; ECED - End Date or Report
; ECL - Location to report (1 or ALL)
; ECD - DSS Unit to report (1, some or ALL)
; ECDUZ - User ien (#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 ECV,ECI,ECOSN,ECLOC,ECDSSU,ECDATE,ECNT,ECSAVE,ECROU,ECDESC,DIC,X,Y
S ECV="ECOS^ECL^ECD0^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
S DIC=723,DIC(0)="QNMZX",X=ECOS D ^DIC D:Y<0 Q:Y<0 S ECOSN=$P(Y,U,2)
. S ^TMP("ECMSG",$J)="1^Invalid Ordering Section.",ECERR=1
D I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1 Q
. K DIC I ECL="ALL" D LOCARRY^ECRUTL Q
. S DIC=4,DIC(0)="QNZX",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
. . 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
D DATECHK(.ECSD,.ECED)
S ECSD=ECSD-.0001,ECED=ECED+.9999
I ECPTYP="P" D Q
. S ECV="ECOS^ECSD^ECED^ECOSN",ECROU="START^ECOSSUM"
. S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
. S ECDESC="EC Ordering Section Summary"
. D QUEUE
D START^ECOSSUM
Q
ECPCER ;PCE Data Summary Report for RPC Call
; Variables passed in
; ECDFN - Patient IEN for file #2
; 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,ECPAT,ECROU,ECDESC,X,DIC,Y
S ECV="ECDFN^ECSD^ECED" D REQCHK(ECV) I ECERR Q
S DIC=2,DIC(0)="QNMZX",X=ECDFN D ^DIC D:Y<0 Q:Y<0 S ECPAT=$P(Y,U,2)
. S ^TMP("ECMSG",$J)="1^Invalid Provider."
D DATECHK(.ECSD,.ECED)
S ECSD=ECSD-.0001,ECED=ECED+.9999
I ECPTYP="P" D Q
. S ECV="ECDFN^ECPAT^ECDATE^ECSD^ECED",ECROU="SUM^ECPCER"
. S ECDESC="ECS/PCE PATIENT SUMMARY"
. D QUEUE
D SUM^ECPCER
Q
ECRDSSA ;DSS Unit Activity Report
; Variables passed in
; ECL - Location to report (1 or ALL)
; ECD0 - DSS Unit to report (1, some or ALL)
; ECSORT - Sort type(P,S or R)
; 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 ECLOC,ECDSSU,ECV,ECI,ECSTDT,ECENDDT,ECKEY,ECROU,ECSAVE,ECDESC,ECNT
N ECDATE,ECX,DIC,X,Y
S ECV="ECL^ECD0^ECSORT^ECSD^ECED^ECDUZ" D REQCHK(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_"^"_$P(Y,U,2)
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^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 DATECHK(.ECSD,.ECED)
S ECSTDT=ECSD-.0001,ECENDDT=ECED+.9999
I ECPTYP="P" D Q
. S ECV="ECSORT^ECDATE^ECSTDT^ECENDDT",ECROU="STRPT^ECRDSSA"
. S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
. S ECDESC="DSS UNIT ACTIVITY REPORT"
. D QUEUE
D STRPT^ECRDSSA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRRPT 10525 printed Dec 13, 2024@01:58:44 Page 2
ECRRPT ;ALB/JAM - Event Capture Report RPC Broker ;10/22/18 15:17
+1 ;;2.0;EVENT CAPTURE;**25,32,41,56,61,82,94,95,108,112,119,122,126,145**;8 May 96;Build 6
+2 ;
+3 ;119 For patch 119, added comment regarding ECPTYP being set to "E" when exporting, for those reports that are now exportable.
REQCHK(ECV) ;Required data check
+1 NEW I,C
+2 SET C=1
+3 FOR I=1:1:$LENGTH(ECV,U)
IF '$DATA(@$PIECE(ECV,U,I))
Begin DoDot:1
+4 SET ^TMP("ECMSG",$JOB,C)="0^Required data missing "_$PIECE(ECV,U,I)
+5 SET C=C+1
SET ECERR=1
End DoDot:1
+6 QUIT
DATECHK(ECSD,ECED) ;Check human format date and converts to FileMan format
+1 ; Input ECSD - Start Date (ex. 10/9/01)
+2 ; ECED - End Date
+3 NEW ECI,X,Y
+4 SET %DT="X"
FOR ECI="ECSD","ECED"
SET X=@ECI
DO ^%DT
SET @ECI=Y
+5 SET ECSD=$SELECT(ECSD=-1:DT,1:ECSD)
SET ECED=$SELECT(ECED=-1:DT,1:ECED)
+6 SET ECDATE=$$FMTE^XLFDT(ECSD)_"^"_$$FMTE^XLFDT(ECED)
+7 QUIT
QUEUE ;Queues report to printer
+1 NEW ZTIO,ZTDESC,ZTRTN,ZTDTH,ZTSAVE,%ZIS,I,IOP,POP
+2 SET IOP="Q;`"_ECDEV
SET %ZIS="Q"
DO ^%ZIS
IF POP
Begin DoDot:1
+3 SET ^TMP("ECMSG",$JOB,1)="0^Device selection unsuccessful"
End DoDot:1
QUIT
+4 SET ZTIO=ION
SET ZTDESC=ECDESC
SET ZTRTN=ECROU
+5 SET ZTDTH=$$FMTH^XLFDT(ECQDT)
+6 ;D NOW^%DTC S ZTDTH=$S(%'<ECQDT:%+.0002,1:ECQDT)
+7 FOR I=1:1:$LENGTH(ECV,U)
IF $DATA(@$PIECE(ECV,U,I))
SET ZTSAVE($PIECE(ECV,U,I))=""
+8 MERGE ZTSAVE=ECSAVE
+9 ;K IO("Q")
DO ^%ZTLOAD
DO HOME^%ZIS
DO ^%ZISC
+10 IF $DATA(ZTSK)
SET ^TMP("ECMSG",$JOB)="1^Report queued. Task #"_ZTSK
QUIT
+11 SET ^TMP("ECMSG",$JOB)="0^Task Rejected"
+12 QUIT
+13 ;
ECPAT ;Patient Summary Report for RPC Call
+1 ; Variables passed in
+2 ; ECDFN - Patient IEN for file #2
+3 ; ECSD - Start Date or Report
+4 ; ECED - End Date or Report
+5 ; ECRY - Print Procedure Reason (optional)
+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 ECDATE,ECPAT,ECV,DIC,X,Y,ECROU,ECDESC
+12 SET ECV="ECDFN^ECSD^ECED"
DO REQCHK(ECV)
IF ECERR
QUIT
+13 SET DIC=2
SET DIC(0)="QNMZX"
SET X=ECDFN
DO ^DIC
if Y<0
QUIT
SET ECPAT=$PIECE(Y,U,2)
+14 ;EC*2.0*108 - Convert Date/Time to Date only
+15 SET ECSD=$PIECE(ECSD,".")
SET ECED=$PIECE(ECED,".")
+16 DO DATECHK(.ECSD,.ECED)
+17 SET ECSD=ECSD-.0001
SET ECED=ECED+.9999
+18 IF $EXTRACT($GET(ECRY))'="Y"
KILL ECRY
+19 IF ECPTYP="P"
Begin DoDot:1
+20 SET ECV="ECDFN^ECPAT^ECDATE^ECSD^ECED^ECRY"
SET ECROU="SUM^ECPAT"
+21 SET ECDESC="EVENT CAPTURE PATIENT SUMMARY"
+22 DO QUEUE
End DoDot:1
QUIT
+23 DO SUM^ECPAT
+24 QUIT
ECRDSSU ;DSS Unit Workload Summary Report
+1 ; Variables passed in
+2 ; ECL - Location to report (1 or ALL)
+3 ; ECD - DSS Unit to report (1, some or ALL)
+4 ; ECSD - Start Date or Report
+5 ; ECED - End Date or Report
+6 ; ECDUZ - User IEN from file (#200)
+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 ECLOC,ECDSSU,ECV,ECI,ECSTDT,ECENDDT,ECKEY,ECROU,ECSAVE,ECDESC,ECNT
+13 NEW ECDATE,ECX,DIC,X,Y
+14 SET ECV="ECL^ECD0^ECSD^ECED^ECDUZ"
DO REQCHK(ECV)
IF ECERR
QUIT
+15 Begin DoDot:1
+16 IF ECL="ALL"
DO LOCARRY^ECRUTL
QUIT
+17 SET DIC=4
SET DIC(0)="QNZX"
SET X=ECL
DO ^DIC
if Y<0
QUIT
SET ECLOC(1)=+Y_"^"_$PIECE(Y,U,2)
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 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 DO DATECHK(.ECSD,.ECED)
+25 SET ECSTDT=ECSD-.0001
SET ECENDDT=ECED+.9999
+26 IF ECPTYP="P"
Begin DoDot:1
+27 SET ECV="ECDATE^ECSTDT^ECENDDT"
SET ECROU="STRPT^ECRDSSU"
+28 SET (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
+29 SET ECDESC="DSS UNIT WORKLOAD SUMMARY REPORT"
+30 DO QUEUE
End DoDot:1
QUIT
+31 DO STRPT^ECRDSSU
+32 QUIT
PROSUM ;Provider (1-7) Summary Report for RPC Call 119-Updated comment to reflect 7 instead of 3
+1 ; Variables passed in
+2 ; ECU - Provider IEN for file #200
+3 ; ECL0 - All, 1, or many locations
+4 ; ECD0 - All, 1, or many DSS units
+5 ; ECSD - Start Date or Report
+6 ; ECED - End Date or Report
+7 ; ECRY - Print Procedure Reason (optional)
+8 ; ECPTYP - Where to send output (P)rinter, (D)evice or screen
+9 ; or (E)xport
+10 ;
+11 ; Variable return
+12 ; ^TMP($J,"ECRPT",n)=report output or to print device.
+13 ;126
NEW ECV,ECDATE,ECUN,ECROU,ECDESC,DIC,X,Y,ECSAVE,ECSLOC,ECSUNIT,NUM
+14 ;126
SET ECV="ECU^ECSD^ECED^ECL0^ECD0"
DO REQCHK(ECV)
IF ECERR
QUIT
+15 SET DIC=200
SET DIC(0)="QNZX"
SET X=ECU
DO ^DIC
if Y<0
Begin DoDot:1
+16 SET ^TMP("ECMSG",$JOB)="1^Invalid Provider."
End DoDot:1
if Y<0
QUIT
SET ECUN=$PIECE(Y,U,2)
+17 DO DATECHK(.ECSD,.ECED)
+18 ;126
IF ECL0="ALL"
SET ECSLOC="ALL"
+19 ;126
IF ECL0'="ALL"
FOR NUM=0:1
if '$DATA(@("ECL"_NUM))
QUIT
SET ECSLOC(@("ECL"_NUM))=""
+20 ;126
IF ECD0="ALL"
SET ECSUNIT="ALL"
+21 ;126
IF ECD0'="ALL"
FOR NUM=0:1
if '$DATA(@("ECD"_NUM))
QUIT
SET ECSUNIT(@("ECD"_NUM))=""
+22 IF ECRY'="Y"
KILL ECRY
+23 IF ECPTYP="P"
Begin DoDot:1
+24 SET ECV="ECU^ECUN^ECDATE^ECSD^ECED^ECRY"
+25 ;126
SET ECSAVE("ECSLOC*")=""
SET ECSAVE("ECSUNIT*")=""
+26 SET ECROU="EN^ECPRSUM1"
SET ECDESC="Event Capture Provider Summary"
+27 DO QUEUE
End DoDot:1
QUIT
+28 DO EN^ECPRSUM1
+29 QUIT
ECPROV ;Provider Summary Report for RPC Call
+1 ; Variables passed in
+2 ; ECL - Location to report (1 or ALL)
+3 ; ECD - DSS Unit to report (1 or ALL)
+4 ; ECSD - Start Date or Report
+5 ; ECED - End Date or Report
+6 ; ECRY - Print Procedure Reason (optional)
+7 ; ECDUZ - User DUZ (ien in #200)
+8 ; ECPTYP - Where to send output (P)rinter, (D)evice or screen
+9 ; or (E)xport
+10 ;
+11 ; Variable return
+12 ; ^TMP($J,"ECRPT",n)=report output or to print device.
+13 NEW ECV,ECDN,ECDATE,ECLN,ECSAVE,ECDESC,ECROU,DIC,X,Y,CNT,UNIT
+14 SET ECDN="ALL"
SET ECV="ECL^ECD^ECSD^ECED^ECDUZ"
DO REQCHK(ECV)
IF ECERR
QUIT
+15 IF ECL'="ALL"
Begin DoDot:1
+16 ;The line below was changed by VMP for NOIS ANN-1003-42305
+17 SET DIC=4
SET DIC(0)="QNZX"
SET X=ECL
DO ^DIC
if Y<0
Begin DoDot:2
+18 SET ^TMP("ECMSG",$JOB)="1^Invalid Location."
SET ECERR=1
End DoDot:2
if Y<0
QUIT
SET ECLN=$PIECE(Y,U,2)
End DoDot:1
IF ECERR
QUIT
+19 IF ECD'="ALL"
KILL DIC
Begin DoDot:1
+20 ;145
SET DIC=724
SET DIC(0)="QNZX"
SET X=ECD
DO ^DIC
if Y<0
Begin DoDot:2
+21 SET ^TMP("ECMSG",$JOB)="1^Invalid Location."
SET ECERR=1
End DoDot:2
if Y<0
QUIT
SET ECDN=$PIECE(Y,U,2)
End DoDot:1
IF ECERR
QUIT
+22 IF ECD="ALL"
IF '$DATA(^XUSEC("ECALLU",ECDUZ))
Begin DoDot:1
+23 SET (ECD,ECDN)="SOME"
SET (X,CNT)=0
+24 FOR
SET X=$ORDER(^VA(200,ECDUZ,"EC",X))
if 'X
QUIT
Begin DoDot:2
+25 SET CNT=CNT+1
SET UNIT=$PIECE(^VA(200,ECDUZ,"EC",X,0),"^")
+26 SET UNIT(CNT)=UNIT_"^"_$PIECE(^ECD(UNIT,0),"^")
End DoDot:2
End DoDot:1
+27 ;I $E($G(ECRY))'="Y" K ECRY ;112 Removed check for ECRY as reasons always print - remove comment and next line to restore reason check
+28 ;112 Reasons always print
SET ECRY="Y"
+29 DO DATECHK(.ECSD,.ECED)
+30 SET ECSD=ECSD-.0001
SET ECED=ECED+.9999
if '$DATA(UNIT)
SET UNIT=""
+31 IF ECPTYP="P"
Begin DoDot:1
+32 SET ECV="ECDATE^ECSD^ECED^ECRY"
SET ECROU="START^ECPROV2"
+33 SET (ECSAVE("ECL*"),ECSAVE("ECD*"),ECSAVE("UNIT*"))=""
+34 SET ECDESC="EVENT CAPTURE PROVIDER SUMMARY"
+35 DO QUEUE
End DoDot:1
QUIT
+36 USE IO
DO START^ECPROV2
+37 QUIT
ECOSSUM ;Ordering Section Summary Report for RPC Call
+1 ; Variables passed in
+2 ; ECOS - Ordering Section
+3 ; ECSD - Start Date or Report
+4 ; ECED - End Date or Report
+5 ; ECL - Location to report (1 or ALL)
+6 ; ECD - DSS Unit to report (1, some or ALL)
+7 ; ECDUZ - User ien (#200)
+8 ; ECPTYP - Where to send output (P)rinter, (D)evice or screen
+9 ; or (E)xport
+10 ;
+11 ; Variable return
+12 ; ^TMP($J,"ECRPT",n)=report output or to print device.
+13 NEW ECV,ECI,ECOSN,ECLOC,ECDSSU,ECDATE,ECNT,ECSAVE,ECROU,ECDESC,DIC,X,Y
+14 SET ECV="ECOS^ECL^ECD0^ECSD^ECED^ECDUZ"
DO REQCHK(ECV)
IF ECERR
QUIT
+15 SET DIC=723
SET DIC(0)="QNMZX"
SET X=ECOS
DO ^DIC
if Y<0
Begin DoDot:1
+16 SET ^TMP("ECMSG",$JOB)="1^Invalid Ordering Section."
SET ECERR=1
End DoDot:1
if Y<0
QUIT
SET ECOSN=$PIECE(Y,U,2)
+17 Begin DoDot:1
+18 KILL DIC
IF ECL="ALL"
DO LOCARRY^ECRUTL
QUIT
+19 SET DIC=4
SET DIC(0)="QNZX"
SET X=ECL
DO ^DIC
if Y<0
QUIT
SET ECLOC(1)=+Y_"^"_$PIECE(Y,U,2)
End DoDot:1
IF '$DATA(ECLOC)
SET ^TMP("ECMSG",$JOB)="1^Invalid Location."
SET ECERR=1
QUIT
+20 Begin DoDot:1
+21 IF ECD0="ALL"
Begin DoDot:2
+22 SET ECKEY=$SELECT($DATA(^XUSEC("ECALLU",ECDUZ)):1,1:0)
DO ALLU^ECRUTL
End DoDot:2
QUIT
+23 SET (ECI,ECNT)=0
FOR ECI=0:1
SET ECX="ECD"_ECI
if '$DATA(@ECX)
QUIT
Begin DoDot:2
+24 ;145
KILL DIC
SET DIC=724
SET DIC(0)="QNZX"
SET X=@ECX
DO ^DIC
IF Y<0
QUIT
+25 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
+26 DO DATECHK(.ECSD,.ECED)
+27 SET ECSD=ECSD-.0001
SET ECED=ECED+.9999
+28 IF ECPTYP="P"
Begin DoDot:1
+29 SET ECV="ECOS^ECSD^ECED^ECOSN"
SET ECROU="START^ECOSSUM"
+30 SET (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
+31 SET ECDESC="EC Ordering Section Summary"
+32 DO QUEUE
End DoDot:1
QUIT
+33 DO START^ECOSSUM
+34 QUIT
ECPCER ;PCE Data Summary Report for RPC Call
+1 ; Variables passed in
+2 ; ECDFN - Patient IEN for file #2
+3 ; ECSD - Start Date or Report
+4 ; ECED - End Date or Report
+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,ECPAT,ECROU,ECDESC,X,DIC,Y
+11 SET ECV="ECDFN^ECSD^ECED"
DO REQCHK(ECV)
IF ECERR
QUIT
+12 SET DIC=2
SET DIC(0)="QNMZX"
SET X=ECDFN
DO ^DIC
if Y<0
Begin DoDot:1
+13 SET ^TMP("ECMSG",$JOB)="1^Invalid Provider."
End DoDot:1
if Y<0
QUIT
SET ECPAT=$PIECE(Y,U,2)
+14 DO DATECHK(.ECSD,.ECED)
+15 SET ECSD=ECSD-.0001
SET ECED=ECED+.9999
+16 IF ECPTYP="P"
Begin DoDot:1
+17 SET ECV="ECDFN^ECPAT^ECDATE^ECSD^ECED"
SET ECROU="SUM^ECPCER"
+18 SET ECDESC="ECS/PCE PATIENT SUMMARY"
+19 DO QUEUE
End DoDot:1
QUIT
+20 DO SUM^ECPCER
+21 QUIT
ECRDSSA ;DSS Unit Activity Report
+1 ; Variables passed in
+2 ; ECL - Location to report (1 or ALL)
+3 ; ECD0 - DSS Unit to report (1, some or ALL)
+4 ; ECSORT - Sort type(P,S or R)
+5 ; ECSD - Start Date or Report
+6 ; ECED - End Date or Report
+7 ; ECDUZ - User IEN from file (#200)
+8 ; ECPTYP - Where to send output (P)rinter, (D)evice or screen
+9 ; or (E)xport
+10 ;
+11 ; Variable return
+12 ; ^TMP($J,"ECRPT",n)=report output or to print device.
+13 NEW ECLOC,ECDSSU,ECV,ECI,ECSTDT,ECENDDT,ECKEY,ECROU,ECSAVE,ECDESC,ECNT
+14 NEW ECDATE,ECX,DIC,X,Y
+15 SET ECV="ECL^ECD0^ECSORT^ECSD^ECED^ECDUZ"
DO REQCHK(ECV)
IF ECERR
QUIT
+16 Begin DoDot:1
+17 IF ECL="ALL"
DO LOCARRY^ECRUTL
QUIT
+18 SET DIC=4
SET DIC(0)="QNZX"
SET X=ECL
DO ^DIC
if Y<0
QUIT
SET ECLOC(1)=+Y_"^"_$PIECE(Y,U,2)
End DoDot:1
IF '$DATA(ECLOC)
SET ^TMP("ECMSG",$JOB)="1^Invalid Location."
QUIT
+19 Begin DoDot:1
+20 IF ECD0="ALL"
Begin DoDot:2
+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 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 DO DATECHK(.ECSD,.ECED)
+26 SET ECSTDT=ECSD-.0001
SET ECENDDT=ECED+.9999
+27 IF ECPTYP="P"
Begin DoDot:1
+28 SET ECV="ECSORT^ECDATE^ECSTDT^ECENDDT"
SET ECROU="STRPT^ECRDSSA"
+29 SET (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
+30 SET ECDESC="DSS UNIT ACTIVITY REPORT"
+31 DO QUEUE
End DoDot:1
QUIT
+32 DO STRPT^ECRDSSA
+33 QUIT
