Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECRRPT

ECRRPT.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;119 For patch 119, added comment regarding ECPTYP being set to "E" when exporting, for those reports that are now exportable.
  1. REQCHK(ECV) ;Required data check
  1.  N I,C
  1.  S C=1
  1.  F I=1:1:$L(ECV,U) I '$D(@$P(ECV,U,I)) D
  1.  . S ^TMP("ECMSG",$J,C)="0^Required data missing "_$P(ECV,U,I)
  1.  . S C=C+1,ECERR=1
  1.  Q
  1. DATECHK(ECSD,ECED) ;Check human format date and converts to FileMan format
  1.  ;    Input  ECSD  - Start Date (ex. 10/9/01)
  1.  ;           ECED  - End Date
  1.  N ECI,X,Y
  1.  S %DT="X" F ECI="ECSD","ECED" S X=@ECI D ^%DT S @ECI=Y
  1.  S ECSD=$S(ECSD=-1:DT,1:ECSD),ECED=$S(ECED=-1:DT,1:ECED)
  1.  S ECDATE=$$FMTE^XLFDT(ECSD)_"^"_$$FMTE^XLFDT(ECED)
  1.  Q
  1. QUEUE ;Queues report to printer
  1.  N ZTIO,ZTDESC,ZTRTN,ZTDTH,ZTSAVE,%ZIS,I,IOP,POP
  1.  S IOP="Q;`"_ECDEV,%ZIS="Q" D ^%ZIS I POP D  Q
  1.  . S ^TMP("ECMSG",$J,1)="0^Device selection unsuccessful"
  1.  S ZTIO=ION,ZTDESC=ECDESC,ZTRTN=ECROU
  1.  S ZTDTH=$$FMTH^XLFDT(ECQDT)
  1.  ;D NOW^%DTC S ZTDTH=$S(%'<ECQDT:%+.0002,1:ECQDT)
  1.  F I=1:1:$L(ECV,U) I $D(@$P(ECV,U,I)) S ZTSAVE($P(ECV,U,I))=""
  1.  M ZTSAVE=ECSAVE
  1.  D ^%ZTLOAD,HOME^%ZIS,^%ZISC ;K IO("Q")
  1.  I $D(ZTSK) S ^TMP("ECMSG",$J)="1^Report queued. Task #"_ZTSK Q
  1.  S ^TMP("ECMSG",$J)="0^Task Rejected"
  1.  Q
  1.  ;
  1. ECPAT ;Patient Summary Report for RPC Call
  1.  ;     Variables passed in
  1.  ;       ECDFN  - Patient IEN for file #2
  1.  ;       ECSD   - Start Date or Report
  1.  ;       ECED   - End Date or Report
  1.  ;       ECRY   - Print Procedure Reason (optional)
  1.  ;       ECPTYP - Where to send output (P)rinter, (D)evice or screen
  1.  ;                or (E)xport
  1.  ;
  1.  ;     Variable return
  1.  ;       ^TMP($J,"ECRPT",n)=report output or to print device.
  1.  N ECDATE,ECPAT,ECV,DIC,X,Y,ECROU,ECDESC
  1.  S ECV="ECDFN^ECSD^ECED" D REQCHK(ECV) I ECERR Q
  1.  S DIC=2,DIC(0)="QNMZX",X=ECDFN D ^DIC Q:Y<0  S ECPAT=$P(Y,U,2)
  1.  ;EC*2.0*108 - Convert Date/Time to Date only
  1.  S ECSD=$P(ECSD,"."),ECED=$P(ECED,".")
  1.  D DATECHK(.ECSD,.ECED)
  1.  S ECSD=ECSD-.0001,ECED=ECED+.9999
  1.  I $E($G(ECRY))'="Y" K ECRY
  1.  I ECPTYP="P" D  Q
  1.  . S ECV="ECDFN^ECPAT^ECDATE^ECSD^ECED^ECRY",ECROU="SUM^ECPAT"
  1.  . S ECDESC="EVENT CAPTURE PATIENT SUMMARY"
  1.  . D QUEUE
  1.  D SUM^ECPAT
  1.  Q
  1. ECRDSSU ;DSS Unit Workload Summary Report
  1.  ;     Variables passed in
  1.  ;       ECL    - Location to report (1 or ALL)
  1.  ;       ECD    - DSS Unit to report (1, some or ALL)
  1.  ;       ECSD   - Start Date or Report
  1.  ;       ECED   - End Date or Report
  1.  ;       ECDUZ  - User IEN from file (#200)
  1.  ;       ECPTYP - Where to send output (P)rinter, (D)evice or screen
  1.  ;                or (E)xport
  1.  ;
  1.  ;     Variable return
  1.  ;       ^TMP($J,"ECRPT",n)=report output or to print device.
  1.  N ECLOC,ECDSSU,ECV,ECI,ECSTDT,ECENDDT,ECKEY,ECROU,ECSAVE,ECDESC,ECNT
  1.  N ECDATE,ECX,DIC,X,Y
  1.  S ECV="ECL^ECD0^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
  1.  D  I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location." Q
  1.  . I ECL="ALL" D LOCARRY^ECRUTL Q
  1.  . S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC Q:Y<0  S ECLOC(1)=+Y_"^"_$P(Y,U,2)
  1.  D  I '$D(ECDSSU) S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q
  1.  . I ECD0="ALL" D  Q
  1.  . . S ECKEY=$S($D(^XUSEC("ECALLU",ECDUZ)):1,1:0) D ALLU^ECRUTL
  1.  . S (ECI,ECNT)=0 F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX)  D
  1.  . . K DIC S DIC=724,DIC(0)="QNZX",X=@ECX D ^DIC I Y<0 Q
  1.  . . S ECNT=ECNT+1,ECDSSU(ECNT)=Y
  1.  D DATECHK(.ECSD,.ECED)
  1.  S ECSTDT=ECSD-.0001,ECENDDT=ECED+.9999
  1.  I ECPTYP="P" D  Q
  1.  . S ECV="ECDATE^ECSTDT^ECENDDT",ECROU="STRPT^ECRDSSU"
  1.  . S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
  1.  . S ECDESC="DSS UNIT WORKLOAD SUMMARY REPORT"
  1.  . D QUEUE
  1.  D STRPT^ECRDSSU
  1.  Q
  1. PROSUM ;Provider (1-7) Summary Report for RPC Call 119-Updated comment to reflect 7 instead of 3
  1.  ;     Variables passed in
  1.  ;       ECU    - Provider IEN for file #200
  1.  ;       ECL0   - All, 1, or many locations
  1.  ;       ECD0   - All, 1, or many DSS units
  1.  ;       ECSD   - Start Date or Report
  1.  ;       ECED   - End Date or Report
  1.  ;       ECRY   - Print Procedure Reason (optional)
  1.  ;       ECPTYP - Where to send output (P)rinter, (D)evice or screen
  1.  ;                or (E)xport
  1.  ;
  1.  ;     Variable return
  1.  ;       ^TMP($J,"ECRPT",n)=report output or to print device.
  1.  N ECV,ECDATE,ECUN,ECROU,ECDESC,DIC,X,Y,ECSAVE,ECSLOC,ECSUNIT,NUM ;126
  1.  S ECV="ECU^ECSD^ECED^ECL0^ECD0" D REQCHK(ECV) I ECERR Q  ;126
  1.  S DIC=200,DIC(0)="QNZX",X=ECU D ^DIC D:Y<0  Q:Y<0  S ECUN=$P(Y,U,2)
  1.  . S ^TMP("ECMSG",$J)="1^Invalid Provider."
  1.  D DATECHK(.ECSD,.ECED)
  1.  I ECL0="ALL" S ECSLOC="ALL" ;126
  1.  I ECL0'="ALL" F NUM=0:1 Q:'$D(@("ECL"_NUM))  S ECSLOC(@("ECL"_NUM))="" ;126
  1.  I ECD0="ALL" S ECSUNIT="ALL" ;126
  1.  I ECD0'="ALL" F NUM=0:1 Q:'$D(@("ECD"_NUM))  S ECSUNIT(@("ECD"_NUM))="" ;126
  1.  I ECRY'="Y" K ECRY
  1.  I ECPTYP="P" D  Q
  1.  . S ECV="ECU^ECUN^ECDATE^ECSD^ECED^ECRY"
  1.  . S ECSAVE("ECSLOC*")="",ECSAVE("ECSUNIT*")="" ;126
  1.  . S ECROU="EN^ECPRSUM1",ECDESC="Event Capture Provider Summary"
  1.  . D QUEUE
  1.  D EN^ECPRSUM1
  1.  Q
  1. ECPROV ;Provider Summary Report for RPC Call
  1.  ;     Variables passed in
  1.  ;       ECL    - Location to report (1 or ALL)
  1.  ;       ECD    - DSS Unit to report (1 or ALL)
  1.  ;       ECSD   - Start Date or Report
  1.  ;       ECED   - End Date or Report
  1.  ;       ECRY   - Print Procedure Reason (optional)
  1.  ;       ECDUZ  - User DUZ (ien in #200)
  1.  ;       ECPTYP - Where to send output (P)rinter, (D)evice or screen
  1.  ;                or (E)xport
  1.  ;
  1.  ;     Variable return
  1.  ;       ^TMP($J,"ECRPT",n)=report output or to print device.
  1.  N ECV,ECDN,ECDATE,ECLN,ECSAVE,ECDESC,ECROU,DIC,X,Y,CNT,UNIT
  1.  S ECDN="ALL",ECV="ECL^ECD^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
  1.  I ECL'="ALL" D  I ECERR Q
  1.  . ;The line below was changed by VMP for NOIS ANN-1003-42305
  1.  . S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC D:Y<0  Q:Y<0  S ECLN=$P(Y,U,2)
  1.  . . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
  1.  I ECD'="ALL" K DIC D  I ECERR Q
  1.  . S DIC=724,DIC(0)="QNZX",X=ECD D ^DIC D:Y<0  Q:Y<0  S ECDN=$P(Y,U,2) ;145
  1.  . . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
  1.  I ECD="ALL",'$D(^XUSEC("ECALLU",ECDUZ)) D
  1.  . S (ECD,ECDN)="SOME",(X,CNT)=0
  1.  . F  S X=$O(^VA(200,ECDUZ,"EC",X)) Q:'X  D
  1.  . . S CNT=CNT+1,UNIT=$P(^VA(200,ECDUZ,"EC",X,0),"^")
  1.  . . S UNIT(CNT)=UNIT_"^"_$P(^ECD(UNIT,0),"^")
  1.  ;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
  1.  S ECRY="Y" ;112 Reasons always print
  1.  D DATECHK(.ECSD,.ECED)
  1.  S ECSD=ECSD-.0001,ECED=ECED+.9999 S:'$D(UNIT) UNIT=""
  1.  I ECPTYP="P" D  Q
  1.  . S ECV="ECDATE^ECSD^ECED^ECRY",ECROU="START^ECPROV2"
  1.  . S (ECSAVE("ECL*"),ECSAVE("ECD*"),ECSAVE("UNIT*"))=""
  1.  . S ECDESC="EVENT CAPTURE PROVIDER SUMMARY"
  1.  . D QUEUE
  1.  U IO D START^ECPROV2
  1.  Q
  1. ECOSSUM ;Ordering Section Summary Report for RPC Call
  1.  ;     Variables passed in
  1.  ;       ECOS   - Ordering Section
  1.  ;       ECSD   - Start Date or Report
  1.  ;       ECED   - End Date or Report
  1.  ;       ECL    - Location to report (1 or ALL)
  1.  ;       ECD    - DSS Unit to report (1, some or ALL)
  1.  ;       ECDUZ  - User ien (#200)
  1.  ;       ECPTYP - Where to send output (P)rinter, (D)evice or screen
  1.  ;                or (E)xport
  1.  ;
  1.  ;     Variable return
  1.  ;       ^TMP($J,"ECRPT",n)=report output or to print device.
  1.  N ECV,ECI,ECOSN,ECLOC,ECDSSU,ECDATE,ECNT,ECSAVE,ECROU,ECDESC,DIC,X,Y
  1.  S ECV="ECOS^ECL^ECD0^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
  1.  S DIC=723,DIC(0)="QNMZX",X=ECOS D ^DIC D:Y<0  Q:Y<0  S ECOSN=$P(Y,U,2)
  1.  . S ^TMP("ECMSG",$J)="1^Invalid Ordering Section.",ECERR=1
  1.  D  I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1 Q
  1.  . K DIC I ECL="ALL" D LOCARRY^ECRUTL Q
  1.  . S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC Q:Y<0  S ECLOC(1)=+Y_"^"_$P(Y,U,2)
  1.  D  I '$D(ECDSSU) S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q
  1.  . I ECD0="ALL" D  Q
  1.  . . S ECKEY=$S($D(^XUSEC("ECALLU",ECDUZ)):1,1:0) D ALLU^ECRUTL
  1.  . S (ECI,ECNT)=0 F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX)  D
  1.  . . K DIC S DIC=724,DIC(0)="QNZX",X=@ECX D ^DIC I Y<0 Q  ;145
  1.  . . S ECNT=ECNT+1,ECDSSU(ECNT)=Y
  1.  D DATECHK(.ECSD,.ECED)
  1.  S ECSD=ECSD-.0001,ECED=ECED+.9999
  1.  I ECPTYP="P" D  Q
  1.  . S ECV="ECOS^ECSD^ECED^ECOSN",ECROU="START^ECOSSUM"
  1.  . S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
  1.  . S ECDESC="EC Ordering Section Summary"
  1.  . D QUEUE
  1.  D START^ECOSSUM
  1.  Q
  1. ECPCER ;PCE Data Summary Report for RPC Call
  1.  ;     Variables passed in
  1.  ;       ECDFN  - Patient IEN for file #2
  1.  ;       ECSD   - Start Date or Report
  1.  ;       ECED   - End Date or Report
  1.  ;       ECPTYP - Where to send output (P)rinter, (D)evice or screen
  1.  ;                or (E)xport
  1.  ;
  1.  ;     Variable return
  1.  ;       ^TMP($J,"ECRPT",n)=report output or to print device.
  1.  N ECV,ECDATE,ECPAT,ECROU,ECDESC,X,DIC,Y
  1.  S ECV="ECDFN^ECSD^ECED" D REQCHK(ECV) I ECERR Q
  1.  S DIC=2,DIC(0)="QNMZX",X=ECDFN D ^DIC D:Y<0  Q:Y<0  S ECPAT=$P(Y,U,2)
  1.  . S ^TMP("ECMSG",$J)="1^Invalid Provider."
  1.  D DATECHK(.ECSD,.ECED)
  1.  S ECSD=ECSD-.0001,ECED=ECED+.9999
  1.  I ECPTYP="P" D  Q
  1.  . S ECV="ECDFN^ECPAT^ECDATE^ECSD^ECED",ECROU="SUM^ECPCER"
  1.  . S ECDESC="ECS/PCE PATIENT SUMMARY"
  1.  . D QUEUE
  1.  D SUM^ECPCER
  1.  Q
  1. ECRDSSA ;DSS Unit Activity Report
  1.  ;     Variables passed in
  1.  ;       ECL    - Location to report (1 or ALL)
  1.  ;       ECD0   - DSS Unit to report (1, some or ALL)
  1.  ;       ECSORT  - Sort type(P,S or R)
  1.  ;       ECSD   - Start Date or Report
  1.  ;       ECED   - End Date or Report
  1.  ;       ECDUZ  - User IEN from file (#200)
  1.  ;       ECPTYP - Where to send output (P)rinter, (D)evice or screen
  1.  ;                or (E)xport
  1.  ;
  1.  ;     Variable return
  1.  ;       ^TMP($J,"ECRPT",n)=report output or to print device.
  1.  N ECLOC,ECDSSU,ECV,ECI,ECSTDT,ECENDDT,ECKEY,ECROU,ECSAVE,ECDESC,ECNT
  1.  N ECDATE,ECX,DIC,X,Y
  1.  S ECV="ECL^ECD0^ECSORT^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
  1.  D  I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location." Q
  1.  . I ECL="ALL" D LOCARRY^ECRUTL Q
  1.  . S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC Q:Y<0  S ECLOC(1)=+Y_"^"_$P(Y,U,2)
  1.  D  I '$D(ECDSSU) S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q
  1.  . I ECD0="ALL" D  Q
  1.  . . S ECKEY=$S($D(^XUSEC("ECALLU",ECDUZ)):1,1:0) D ALLU^ECRUTL
  1.  . S (ECI,ECNT)=0 F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX)  D
  1.  . . K DIC S DIC=724,DIC(0)="QNZX",X=@ECX D ^DIC I Y<0 Q
  1.  . . S ECNT=ECNT+1,ECDSSU(ECNT)=Y
  1.  D DATECHK(.ECSD,.ECED)
  1.  S ECSTDT=ECSD-.0001,ECENDDT=ECED+.9999
  1.  I ECPTYP="P" D  Q
  1.  . S ECV="ECSORT^ECDATE^ECSTDT^ECENDDT",ECROU="STRPT^ECRDSSA"
  1.  . S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
  1.  . S ECDESC="DSS UNIT ACTIVITY REPORT"
  1.  . D QUEUE
  1.  D STRPT^ECRDSSA
  1.  Q