Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECRRPT.m

    r613 r623  
    1 ECRRPT  ;ALB/JAM;Event Capture Report RPC Broker ;Jan 2, 2001
    2         ;;2.0; EVENT CAPTURE ;**25,32,41,56,61,82,94**;8 May 96;Build 4
    3         ;
    4 REQCHK(ECV)     ;Required data check
    5         N I,C
    6         S C=1
    7         F I=1:1:$L(ECV,U) I '$D(@$P(ECV,U,I)) D
    8         . S ^TMP("ECMSG",$J,C)="0^Required data missing "_$P(ECV,U,I)
    9         . S C=C+1,ECERR=1
    10         Q
    11 DATECHK(ECSD,ECED)      ;Check human format date and converts to FileMan format
    12         ;    Input  ECSD  - Start Date (ex. 10/9/01)
    13         ;           ECED  - End Date
    14         N ECI,X,Y
    15         S %DT="X" F ECI="ECSD","ECED" S X=@ECI D ^%DT S @ECI=Y
    16         S ECSD=$S(ECSD=-1:DT,1:ECSD),ECED=$S(ECED=-1:DT,1:ECED)
    17         S ECDATE=$$FMTE^XLFDT(ECSD)_"^"_$$FMTE^XLFDT(ECED)
    18         Q
    19 QUEUE   ;Queues report to printer
    20         N ZTIO,ZTDESC,ZTRTN,ZTDTH,ZTSAVE,%ZIS,I,IOP,POP
    21         S XNAM=$P($G(^%ZIS(1,ECDEV,0)),U,2)
    22         S IOP="Q;`"_ECDEV,%ZIS="Q" D ^%ZIS I POP D  Q
    23         . ;S IOP="Q;"_XNAM,%ZIS="Q" D ^%ZIS I POP D  Q
    24         . S ^TMP("ECMSG",$J,1)="0^Device selection unsuccessful"
    25         S ZTIO=ION,ZTDESC=ECDESC,ZTRTN=ECROU
    26         S ZTDTH=$$FMTH^XLFDT(ECQDT)
    27         ;D NOW^%DTC S ZTDTH=$S(%'<ECQDT:%+.0002,1:ECQDT)
    28         F I=1:1:$L(ECV,U) I $D(@$P(ECV,U,I)) S ZTSAVE($P(ECV,U,I))=""
    29         M ZTSAVE=ECSAVE
    30         D ^%ZTLOAD,HOME^%ZIS,^%ZISC ;K IO("Q")
    31         I $D(ZTSK) S ^TMP("ECMSG",$J)="1^Report queued. Task #"_ZTSK Q
    32         S ^TMP("ECMSG",$J)="0^Task Rejected"
    33         Q
    34         ;
    35 ECPAT   ;Patient Summary Report for RPC Call
    36         ;     Variables passed in
    37         ;       ECDFN  - Patient IEN for file #2
    38         ;       ECSD   - Start Date or Report
    39         ;       ECED   - End Date or Report
    40         ;       ECRY   - Print Procedure Reason (optional)
    41         ;
    42         ;     Variable return
    43         ;       ^TMP($J,"ECRPT",n)=report output or to print device.
    44         N ECDATE,ECPAT,ECV,DIC,X,Y,ECROU,ECDESC
    45         S ECV="ECDFN^ECSD^ECED" D REQCHK(ECV) I ECERR Q
    46         S DIC=2,DIC(0)="QNMZX",X=ECDFN D ^DIC Q:Y<0  S ECPAT=$P(Y,U,2)
    47         D DATECHK(.ECSD,.ECED)
    48         S ECSD=ECSD-.0001,ECED=ECED+.9999
    49         I $E($G(ECRY))'="Y" K ECRY
    50         I ECPTYP="P" D  Q
    51         . S ECV="ECDFN^ECPAT^ECDATE^ECSD^ECED^ECRY",ECROU="SUM^ECPAT"
    52         . S ECDESC="EVENT CAPTURE PATIENT SUMMARY"
    53         . D QUEUE
    54         D SUM^ECPAT
    55         Q
    56 ECRDSSU ;DSS Unit Workload Summary Report
    57         ;     Variables passed in
    58         ;       ECL    - Location to report (1 or ALL)
    59         ;       ECD    - DSS Unit to report (1, some or ALL)
    60         ;       ECSD   - Start Date or Report
    61         ;       ECED   - End Date or Report
    62         ;       ECDUZ  - User IEN from file (#200)
    63         ;
    64         ;     Variable return
    65         ;       ^TMP($J,"ECRPT",n)=report output or to print device.
    66         N ECLOC,ECDSSU,ECV,ECI,ECSTDT,ECENDDT,ECKEY,ECROU,ECSAVE,ECDESC,ECNT
    67         N ECDATE,ECX,DUZ,DIC,X,Y
    68         S ECV="ECL^ECD0^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
    69         D  I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location." Q
    70         . I ECL="ALL" D LOCARRY^ECRUTL Q
    71         . S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC Q:Y<0  S ECLOC(1)=+Y_"^"_$P(Y,U,2)
    72         D  I '$D(ECDSSU) S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q
    73         . I ECD0="ALL" D  Q
    74         . . S ECKEY=$S($D(^XUSEC("ECALLU",ECDUZ)):1,1:0),DUZ=ECDUZ D ALLU^ECRUTL
    75         . S (ECI,ECNT)=0 F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX)  D
    76         . . K DIC S DIC=724,DIC(0)="QNZX",X=@ECX D ^DIC I Y<0 Q
    77         . . S ECNT=ECNT+1,ECDSSU(ECNT)=Y
    78         D DATECHK(.ECSD,.ECED)
    79         S ECSTDT=ECSD-.0001,ECENDDT=ECED+.9999
    80         I ECPTYP="P" D  Q
    81         . S ECV="ECDATE^ECSTDT^ECENDDT",ECROU="STRPT^ECRDSSU"
    82         . S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
    83         . S ECDESC="DSS UNIT WORKLOAD SUMMARY REPORT"
    84         . D QUEUE
    85         D STRPT^ECRDSSU
    86         Q
    87 PROSUM  ;Provider (1-3) Summary Report for RPC Call
    88         ;     Variables passed in
    89         ;       ECU    - Provider IEN for file #200
    90         ;       ECSD   - Start Date or Report
    91         ;       ECED   - End Date or Report
    92         ;       ECRY   - Print Procedure Reason (optional)
    93         ;
    94         ;     Variable return
    95         ;       ^TMP($J,"ECRPT",n)=report output or to print device.
    96         N ECV,ECDATE,ECUN,ECROU,ECDESC,DIC,X,Y
    97         S ECV="ECU^ECSD^ECED" D REQCHK(ECV) I ECERR Q
    98         S DIC=200,DIC(0)="QNZX",X=ECU D ^DIC D:Y<0  Q:Y<0  S ECUN=$P(Y,U,2)
    99         . S ^TMP("ECMSG",$J)="1^Invalid Provider."
    100         D DATECHK(.ECSD,.ECED)
    101         I ECRY'="Y" K ECRY
    102         I ECPTYP="P" D  Q
    103         . S ECV="ECU^ECUN^ECDATE^ECSD^ECED^ECRY"
    104         . S ECROU="EN^ECPRSUM1",ECDESC="Event Capture Provider Summary"
    105         . D QUEUE
    106         D EN^ECPRSUM1
    107         Q
    108 ECPROV  ;Provider Summary Report for RPC Call
    109         ;     Variables passed in
    110         ;       ECL    - Location to report (1 or ALL)
    111         ;       ECD    - DSS Unit to report (1 or ALL)
    112         ;       ECSD   - Start Date or Report
    113         ;       ECED   - End Date or Report
    114         ;       ECRY   - Print Procedure Reason (optional)
    115         ;       ECDUZ  - User DUZ (ien in #200)
    116         ;
    117         ;     Variable return
    118         ;       ^TMP($J,"ECRPT",n)=report output or to print device.
    119         N ECV,ECDN,ECDATE,ECLN,ECSAVE,ECDESC,ECROU,DIC,X,Y,CNT,UNIT
    120         S ECDN="ALL",ECV="ECL^ECD^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
    121         I ECL'="ALL" D  I ECERR Q
    122         . ;The line below was changed by VMP for NOIS ANN-1003-42305
    123         . S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC D:Y<0  Q:Y<0  S ECLN=$P(Y,U,2)
    124         . . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
    125         I ECD'="ALL" K DIC D  I ECERR Q
    126         . S DIC=724,DIC(0)="QNMZX",X=ECD D ^DIC D:Y<0  Q:Y<0  S ECDN=$P(Y,U,2)
    127         . . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
    128         I ECD="ALL",'$D(^XUSEC("ECALLU",ECDUZ)) D
    129         . S (ECD,ECDN)="SOME",(X,CNT)=0
    130         . F  S X=$O(^VA(200,ECDUZ,"EC",X)) Q:'X  D
    131         . . S CNT=CNT+1,UNIT=$P(^VA(200,ECDUZ,"EC",X,0),"^")
    132         . . S UNIT(CNT)=UNIT_"^"_$P(^ECD(UNIT,0),"^")
    133         I $E($G(ECRY))'="Y" K ECRY
    134         D DATECHK(.ECSD,.ECED)
    135         S ECSD=ECSD-.0001,ECED=ECED+.9999 S:'$D(UNIT) UNIT=""
    136         I ECPTYP="P" D  Q
    137         . S ECV="ECDATE^ECSD^ECED^ECRY",ECROU="START^ECPROV2"
    138         . S (ECSAVE("ECL*"),ECSAVE("ECD*"),ECSAVE("UNIT*"))=""
    139         . S ECDESC="EVENT CAPTURE PROVIDER SUMMARY"
    140         . D QUEUE
    141         U IO D START^ECPROV2
    142         Q
    143 ECOSSUM ;Ordering Section Summary Report for RPC Call
    144         ;     Variables passed in
    145         ;       ECOS   - Ordering Section
    146         ;       ECSD   - Start Date or Report
    147         ;       ECED   - End Date or Report
    148         ;       ECL    - Location to report (1 or ALL)
    149         ;       ECD    - DSS Unit to report (1, some or ALL)
    150         ;       ECDUZ  - User ien (#200)
    151         ;
    152         ;     Variable return
    153         ;       ^TMP($J,"ECRPT",n)=report output or to print device.
    154         N ECV,ECI,ECOSN,ECLOC,ECDSSU,ECDATE,ECNT,ECSAVE,ECROU,ECDESC,DUZ,DIC,X,Y
    155         S ECV="ECOS^ECL^ECD0^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
    156         S DIC=723,DIC(0)="QNMZX",X=ECOS D ^DIC D:Y<0  Q:Y<0  S ECOSN=$P(Y,U,2)
    157         . S ^TMP("ECMSG",$J)="1^Invalid Ordering Section.",ECERR=1
    158         D  I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1 Q
    159         . K DIC I ECL="ALL" D LOCARRY^ECRUTL Q
    160         . S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC Q:Y<0  S ECLOC(1)=+Y_"^"_$P(Y,U,2)
    161         D  I '$D(ECDSSU) S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q
    162         . I ECD0="ALL" D  Q
    163         . . S ECKEY=$S($D(^XUSEC("ECALLU",ECDUZ)):1,1:0),DUZ=ECDUZ D ALLU^ECRUTL
    164         . S (ECI,ECNT)=0 F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX)  D
    165         . . K DIC S DIC=724,DIC(0)="QNMZX",X=@ECX D ^DIC I Y<0 Q
    166         . . S ECNT=ECNT+1,ECDSSU(ECNT)=Y
    167         D DATECHK(.ECSD,.ECED)
    168         S ECSD=ECSD-.0001,ECED=ECED+.9999
    169         I ECPTYP="P" D  Q
    170         . S ECV="ECOS^ECSD^ECED^ECOSN",ECROU="START^ECOSSUM"
    171         . S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
    172         . S ECDESC="EC Ordering Section Summary"
    173         . D QUEUE
    174         D START^ECOSSUM
    175         Q
    176 ECPCER  ;PCE Data Summary Report for RPC Call
    177         ;     Variables passed in
    178         ;       ECDFN  - Patient IEN for file #2
    179         ;       ECSD   - Start Date or Report
    180         ;       ECED   - End Date or Report
    181         ;
    182         ;     Variable return
    183         ;       ^TMP($J,"ECRPT",n)=report output or to print device.
    184         N ECV,ECDATE,ECPAT,ECROU,ECDESC,X,DIC,Y
    185         S ECV="ECDFN^ECSD^ECED" D REQCHK(ECV) I ECERR Q
    186         S DIC=2,DIC(0)="QNMZX",X=ECDFN D ^DIC D:Y<0  Q:Y<0  S ECPAT=$P(Y,U,2)
    187         . S ^TMP("ECMSG",$J)="1^Invalid Provider."
    188         D DATECHK(.ECSD,.ECED)
    189         S ECSD=ECSD-.0001,ECED=ECED+.9999
    190         I ECPTYP="P" D  Q
    191         . S ECV="ECDFN^ECPAT^ECDATE^ECSD^ECED",ECROU="SUM^ECPCER"
    192         . S ECDESC="ECS/PCE PATIENT SUMMARY"
    193         . D QUEUE
    194         D SUM^ECPCER
    195         Q
     1ECRRPT ;ALB/JAM;Event Capture Report RPC Broker ;Jan 2, 2001
     2 ;;2.0; EVENT CAPTURE ;**25,32,41,56,61,82**;8 May 96
     3 ;
     4REQCHK(ECV) ;Required data check
     5 N I,C
     6 S C=1
     7 F I=1:1:$L(ECV,U) I '$D(@$P(ECV,U,I)) D
     8 . S ^TMP("ECMSG",$J,C)="0^Required data missing "_$P(ECV,U,I)
     9 . S C=C+1,ECERR=1
     10 Q
     11DATECHK(ECSD,ECED) ;Check human format date and converts to FileMan format
     12 ;    Input  ECSD  - Start Date (ex. 10/9/01)
     13 ;           ECED  - End Date
     14 N ECI,X,Y
     15 S %DT="X" F ECI="ECSD","ECED" S X=@ECI D ^%DT S @ECI=Y
     16 S ECSD=$S(ECSD=-1:DT,1:ECSD),ECED=$S(ECED=-1:DT,1:ECED)
     17 S ECDATE=$$FMTE^XLFDT(ECSD)_"^"_$$FMTE^XLFDT(ECED)
     18 Q
     19QUEUE ;Queues report to printer
     20 N ZTIO,ZTDESC,ZTRTN,ZTDTH,ZTSAVE,%ZIS,I,IOP,POP
     21 S XNAM=$P($G(^%ZIS(1,ECDEV,0)),U,2)
     22 S IOP="Q;`"_ECDEV,%ZIS="Q" D ^%ZIS I POP D  Q
     23 . ;S IOP="Q;"_XNAM,%ZIS="Q" D ^%ZIS I POP D  Q
     24 . S ^TMP("ECMSG",$J,1)="0^Device selection unsuccessful"
     25 S ZTIO=ION,ZTDESC=ECDESC,ZTRTN=ECROU
     26 S ZTDTH=$$FMTH^XLFDT(ECQDT)
     27 ;D NOW^%DTC S ZTDTH=$S(%'<ECQDT:%+.0002,1:ECQDT)
     28 F I=1:1:$L(ECV,U) I $D(@$P(ECV,U,I)) S ZTSAVE($P(ECV,U,I))=""
     29 M ZTSAVE=ECSAVE
     30 D ^%ZTLOAD,HOME^%ZIS,^%ZISC ;K IO("Q")
     31 I $D(ZTSK) S ^TMP("ECMSG",$J)="1^Report queued. Task #"_ZTSK Q
     32 S ^TMP("ECMSG",$J)="0^Task Rejected"
     33 Q
     34 ;
     35ECPAT ;Patient Summary Report for RPC Call
     36 ;     Variables passed in
     37 ;       ECDFN  - Patient IEN for file #2
     38 ;       ECSD   - Start Date or Report
     39 ;       ECED   - End Date or Report
     40 ;       ECRY   - Print Procedure Reason (optional)
     41 ;
     42 ;     Variable return
     43 ;       ^TMP($J,"ECRPT",n)=report output or to print device.
     44 N ECDATE,ECPAT,ECV,DIC,X,Y,ECROU,ECDESC
     45 S ECV="ECDFN^ECSD^ECED" D REQCHK(ECV) I ECERR Q
     46 S DIC=2,DIC(0)="QNMZX",X=ECDFN D ^DIC Q:Y<0  S ECPAT=$P(Y,U,2)
     47 D DATECHK(.ECSD,.ECED)
     48 S ECSD=ECSD-.0001,ECED=ECED+.9999
     49 I $E($G(ECRY))'="Y" K ECRY
     50 I ECPTYP="P" D  Q
     51 . S ECV="ECDFN^ECPAT^ECDATE^ECSD^ECED^ECRY",ECROU="SUM^ECPAT"
     52 . S ECDESC="EVENT CAPTURE PATIENT SUMMARY"
     53 . D QUEUE
     54 D SUM^ECPAT
     55 Q
     56ECRDSSU ;DSS Unit Workload Summary Report
     57 ;     Variables passed in
     58 ;       ECL    - Location to report (1 or ALL)
     59 ;       ECD    - DSS Unit to report (1, some or ALL)
     60 ;       ECSD   - Start Date or Report
     61 ;       ECED   - End Date or Report
     62 ;       ECDUZ  - User IEN from file (#200)
     63 ;
     64 ;     Variable return
     65 ;       ^TMP($J,"ECRPT",n)=report output or to print device.
     66 N ECLOC,ECDSSU,ECV,ECI,ECSTDT,ECENDDT,ECKEY,ECROU,ECSAVE,ECDESC,ECNT
     67 N ECDATE,ECX,DUZ,DIC,X,Y
     68 S ECV="ECL^ECD0^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
     69 D  I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location." Q
     70 . I ECL="ALL" D LOCARRY^ECRUTL Q
     71 . S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC Q:Y<0  S ECLOC(1)=+Y_"^"_$P(Y,U,2)
     72 D  I '$D(ECDSSU) S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q
     73 . I ECD0="ALL" D  Q
     74 . . S ECKEY=$S($D(^XUSEC("ECALLU",ECDUZ)):1,1:0),DUZ=ECDUZ D ALLU^ECRUTL
     75 . S (ECI,ECNT)=0 F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX)  D
     76 . . K DIC S DIC=724,DIC(0)="QNMZX",X=@ECX D ^DIC I Y<0 Q
     77 . . S ECNT=ECNT+1,ECDSSU(ECNT)=Y
     78 D DATECHK(.ECSD,.ECED)
     79 S ECSTDT=ECSD-.0001,ECENDDT=ECED+.9999
     80 I ECPTYP="P" D  Q
     81 . S ECV="ECDATE^ECSTDT^ECENDDT",ECROU="STRPT^ECRDSSU"
     82 . S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
     83 . S ECDESC="DSS UNIT WORKLOAD SUMMARY REPORT"
     84 . D QUEUE
     85 D STRPT^ECRDSSU
     86 Q
     87PROSUM ;Provider (1-3) Summary Report for RPC Call
     88 ;     Variables passed in
     89 ;       ECU    - Provider IEN for file #200
     90 ;       ECSD   - Start Date or Report
     91 ;       ECED   - End Date or Report
     92 ;       ECRY   - Print Procedure Reason (optional)
     93 ;
     94 ;     Variable return
     95 ;       ^TMP($J,"ECRPT",n)=report output or to print device.
     96 N ECV,ECDATE,ECUN,ECROU,ECDESC,DIC,X,Y
     97 S ECV="ECU^ECSD^ECED" D REQCHK(ECV) I ECERR Q
     98 S DIC=200,DIC(0)="QNZX",X=ECU D ^DIC D:Y<0  Q:Y<0  S ECUN=$P(Y,U,2)
     99 . S ^TMP("ECMSG",$J)="1^Invalid Provider."
     100 D DATECHK(.ECSD,.ECED)
     101 I ECRY'="Y" K ECRY
     102 I ECPTYP="P" D  Q
     103 . S ECV="ECU^ECUN^ECDATE^ECSD^ECED^ECRY"
     104 . S ECROU="EN^ECPRSUM1",ECDESC="Event Capture Provider Summary"
     105 . D QUEUE
     106 D EN^ECPRSUM1
     107 Q
     108ECPROV ;Provider Summary Report for RPC Call
     109 ;     Variables passed in
     110 ;       ECL    - Location to report (1 or ALL)
     111 ;       ECD    - DSS Unit to report (1 or ALL)
     112 ;       ECSD   - Start Date or Report
     113 ;       ECED   - End Date or Report
     114 ;       ECRY   - Print Procedure Reason (optional)
     115 ;       ECDUZ  - User DUZ (ien in #200)
     116 ;
     117 ;     Variable return
     118 ;       ^TMP($J,"ECRPT",n)=report output or to print device.
     119 N ECV,ECDN,ECDATE,ECLN,ECSAVE,ECDESC,ECROU,DIC,X,Y,CNT,UNIT
     120 S ECDN="ALL",ECV="ECL^ECD^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
     121 I ECL'="ALL" D  I ECERR Q
     122 . ;The line below was changed by VMP for NOIS ANN-1003-42305
     123 . S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC D:Y<0  Q:Y<0  S ECLN=$P(Y,U,2)
     124 . . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
     125 I ECD'="ALL" K DIC D  I ECERR Q
     126 . S DIC=724,DIC(0)="QNMZX",X=ECD D ^DIC D:Y<0  Q:Y<0  S ECDN=$P(Y,U,2)
     127 . . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
     128 I ECD="ALL",'$D(^XUSEC("ECALLU",ECDUZ)) D
     129 . S (ECD,ECDN)="SOME",(X,CNT)=0
     130 . F  S X=$O(^VA(200,ECDUZ,"EC",X)) Q:'X  D
     131 . . S CNT=CNT+1,UNIT=$P(^VA(200,ECDUZ,"EC",X,0),"^")
     132 . . S UNIT(CNT)=UNIT_"^"_$P(^ECD(UNIT,0),"^")
     133 I $E($G(ECRY))'="Y" K ECRY
     134 D DATECHK(.ECSD,.ECED)
     135 S ECSD=ECSD-.0001,ECED=ECED+.9999 S:'$D(UNIT) UNIT=""
     136 I ECPTYP="P" D  Q
     137 . S ECV="ECDATE^ECSD^ECED^ECRY",ECROU="START^ECPROV2"
     138 . S (ECSAVE("ECL*"),ECSAVE("ECD*"),ECSAVE("UNIT*"))=""
     139 . S ECDESC="EVENT CAPTURE PROVIDER SUMMARY"
     140 . D QUEUE
     141 U IO D START^ECPROV2
     142 Q
     143ECOSSUM ;Ordering Section Summary Report for RPC Call
     144 ;     Variables passed in
     145 ;       ECOS   - Ordering Section
     146 ;       ECSD   - Start Date or Report
     147 ;       ECED   - End Date or Report
     148 ;       ECL    - Location to report (1 or ALL)
     149 ;       ECD    - DSS Unit to report (1, some or ALL)
     150 ;       ECDUZ  - User ien (#200)
     151 ;
     152 ;     Variable return
     153 ;       ^TMP($J,"ECRPT",n)=report output or to print device.
     154 N ECV,ECI,ECOSN,ECLOC,ECDSSU,ECDATE,ECNT,ECSAVE,ECROU,ECDESC,DUZ,DIC,X,Y
     155 S ECV="ECOS^ECL^ECD0^ECSD^ECED^ECDUZ" D REQCHK(ECV) I ECERR Q
     156 S DIC=723,DIC(0)="QNMZX",X=ECOS D ^DIC D:Y<0  Q:Y<0  S ECOSN=$P(Y,U,2)
     157 . S ^TMP("ECMSG",$J)="1^Invalid Ordering Section.",ECERR=1
     158 D  I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1 Q
     159 . K DIC I ECL="ALL" D LOCARRY^ECRUTL Q
     160 . S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC Q:Y<0  S ECLOC(1)=+Y_"^"_$P(Y,U,2)
     161 D  I '$D(ECDSSU) S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q
     162 . I ECD0="ALL" D  Q
     163 . . S ECKEY=$S($D(^XUSEC("ECALLU",ECDUZ)):1,1:0),DUZ=ECDUZ D ALLU^ECRUTL
     164 . S (ECI,ECNT)=0 F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX)  D
     165 . . K DIC S DIC=724,DIC(0)="QNMZX",X=@ECX D ^DIC I Y<0 Q
     166 . . S ECNT=ECNT+1,ECDSSU(ECNT)=Y
     167 D DATECHK(.ECSD,.ECED)
     168 S ECSD=ECSD-.0001,ECED=ECED+.9999
     169 I ECPTYP="P" D  Q
     170 . S ECV="ECOS^ECSD^ECED^ECOSN",ECROU="START^ECOSSUM"
     171 . S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("))=""
     172 . S ECDESC="EC Ordering Section Summary"
     173 . D QUEUE
     174 D START^ECOSSUM
     175 Q
     176ECPCER ;PCE Data Summary Report for RPC Call
     177 ;     Variables passed in
     178 ;       ECDFN  - Patient IEN for file #2
     179 ;       ECSD   - Start Date or Report
     180 ;       ECED   - End Date or Report
     181 ;
     182 ;     Variable return
     183 ;       ^TMP($J,"ECRPT",n)=report output or to print device.
     184 N ECV,ECDATE,ECPAT,ECROU,ECDESC,X,DIC,Y
     185 S ECV="ECDFN^ECSD^ECED" D REQCHK(ECV) I ECERR Q
     186 S DIC=2,DIC(0)="QNMZX",X=ECDFN D ^DIC D:Y<0  Q:Y<0  S ECPAT=$P(Y,U,2)
     187 . S ^TMP("ECMSG",$J)="1^Invalid Provider."
     188 D DATECHK(.ECSD,.ECED)
     189 S ECSD=ECSD-.0001,ECED=ECED+.9999
     190 I ECPTYP="P" D  Q
     191 . S ECV="ECDFN^ECPAT^ECDATE^ECSD^ECED",ECROU="SUM^ECPCER"
     192 . S ECDESC="ECS/PCE PATIENT SUMMARY"
     193 . D QUEUE
     194 D SUM^ECPCER
     195 Q
Note: See TracChangeset for help on using the changeset viewer.