source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECRRPT.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.4 KB
Line 
1ECRRPT ;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 ;
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)="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
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 TracBrowser for help on using the repository browser.