source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECRRPT1.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 8.4 KB
Line 
1ECRRPT1 ;ALB/JAM;Event Capture Report RPC Broker ;10-31,2006
2 ;;2.0; EVENT CAPTURE ;**25,32,33,61,78,72,90**;8 May 96;Build 1
3 ;
4ECRPRSN ;Procedure Reason Report for RPC Call
5 ; Variables passed in
6 ; ECSD - Start Date or Report
7 ; ECED - End Date or Report
8 ; ECL - Location to report (1 or ALL)
9 ; ECD0..n - DSS Unit to report (1,some or ALL)
10 ; ECRY0..n - Procedure reason (some or ALL)
11 ;
12 ; Variable return
13 ; ^TMP($J,"ECRPT",n)=report output or to print device.
14 N ECV,ECI,ECLOC,ECDSSU,ECDN,ECDATE,ECUN,ECNT,ECKEY,ECX,DUZ,ECLINK,ECZ
15 N ECROU,ECSAVE,ECDESC,ECW,DIC,X,Y
16 S ECV="ECL^ECD0^ECSD^ECED^ECRY0" D REQCHK^ECRRPT(ECV) I ECERR Q
17 D I '$D(ECLOC) S ^TMP("ECMSG",$J)="1^Invalid Location." Q
18 . I ECL="ALL" D LOCARRY^ECRUTL Q
19 . S DIC=4,DIC(0)="QNMZX",X=ECL D ^DIC Q:Y<0 S ECLOC(1)=+Y_"^"_$P(Y,U,2)
20 D I '$D(ECDSSU) S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q
21 . I ECD0="ALL" D Q
22 . . I '$D(ECDUZ) Q
23 . . S ECKEY=$S($D(^XUSEC("ECALLU",ECDUZ)):1,1:0),DUZ=ECDUZ D ALLU^ECRUTL
24 . S (ECI,ECNT)=0 F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX) D
25 . . K DIC S DIC=724,DIC(0)="QNMZX",X=@ECX D ^DIC I Y<0 Q
26 . . S ECNT=ECNT+1,ECDSSU(ECNT)=Y
27 S ECX=0 D
28 .I ECRY0="ALL" D PXREAS Q
29 .N TLOC,TDSS,ECY
30 .S ECI=0 F S ECI=$O(ECLOC(ECI)) Q:'ECI S TLOC(+ECLOC(ECI))=""
31 .S ECI=0 F S ECI=$O(ECDSSU(ECI)) Q:'ECI S TDSS(+ECDSSU(ECI))=""
32 .S ECI=0 F ECI=0:1 S ECZ="ECRY"_ECI Q:'$D(@ECZ) D
33 ..S ECW=0 F S ECW=$O(^ECL("B",@ECZ,ECW)) Q:'ECW D
34 ...S ECY=$P($G(^ECL(ECW,0)),U,2) Q:ECY="" S ECJ=$P($G(^ECJ(ECY,0)),U)
35 ...Q:ECJ="" Q:'$D(TLOC($P(ECJ,"-"))) Q:'$D(TDSS($P(ECJ,"-",2)))
36 ...S ECLINK(ECW)=$P($G(^ECL(ECW,0)),U)
37 D DATECHK^ECRRPT(.ECSD,.ECED) S ECSD=ECSD-.0001,ECED=ECED+.9999
38 I ECPTYP="P" D Q
39 . S ECV="ECSD^ECED",ECROU="START^ECRPRSN"
40 . S (ECSAVE("ECLOC("),ECSAVE("ECDSSU("),ECSAVE("ECLINK("))=""
41 . S ECDESC="EC Procedure Reason Report"
42 . D QUEUE^ECRRPT
43 D START^ECRPRSN,EXIT^ECRPRSN
44 Q
45PXREAS ;Procedure reason link
46 N ECZ,ECX,ECY,ECV
47 S ECX=0 F S ECX=$O(ECLOC(ECX)) Q:'ECX S ECY=0 D
48 . F S ECY=$O(ECDSSU(ECY)) Q:'ECY S ECV=+ECLOC(ECX)_"-"_+ECDSSU(ECY) D
49 . . S ECZ=ECV_"-0-0"
50 . . F S ECZ=$O(^ECJ("B",ECZ)) Q:('ECZ)!($P(ECZ,"-",1,2)'=ECV) D
51 . . . S ECW=$O(^ECJ("B",ECZ,"")) Q:ECW="" D REALNK
52 Q
53REALNK ;Reason link
54 N XX,YY,ZZ
55 S XX=0 F S XX=$O(^ECL("AD",ECW,XX)) Q:'XX S YY=0 D
56 . F S YY=$O(^ECL("AD",ECW,XX,YY)) Q:'YY D
57 . . Q:$G(^ECL(YY,0))="" S ECLINK(YY)=XX
58 Q
59ECRPERS ;Inactive Person Class Report for RPC Call
60 ; Variables passed in
61 ; ECSD - Start Date or Report
62 ; ECED - End Date or Report
63 ; ECSORT - Sort by Patient (P) or Provider (R)
64 ;
65 ; Variable return
66 ; ^TMP($J,"ECRPT",n)=report output or to print device.
67 N ECV,ECDATE,ECBEGIN,ECEND,ECROU,ECDESC
68 S ECV="ECSD^ECED^ECSORT" D REQCHK^ECRRPT(ECV) I ECERR Q
69 D DATECHK^ECRRPT(.ECSD,.ECED)
70 S ECBEGIN=ECSD-.0001,ECEND=ECED+.9999
71 I ECPTYP="P" D Q
72 . S ECV="ECBEGIN^ECEND^ECSORT",ECROU="START^ECRPCLS"
73 . S ECDESC="EC Invalid Provider Report"
74 . D QUEUE^ECRRPT
75 D START^ECRPCLS
76 Q
77ECDSS1 ;National/Local Procedure Reports for RPC Call
78 ; Variables passed in
79 ; ECRTN - Procedure Report (A-active or I-inactive)
80 ; If ECRTN=A, also
81 ; ECRN - Preferred Report (N-ational, L-ocal or Both)
82 ; ECRD - Sort Method (P-rocedure Name, N-ational Number)
83 ;
84 ; Variable return
85 ; ^TMP($J,"ECRPT",n)=report output or to print device.
86 N ECV,ECDESC,ECROU,DQTIME
87 S ECV=$S($G(ECRTN)="A":"ECRTN^ECRN^ECRD",1:"ECRTN")
88 D REQCHK^ECRRPT(ECV) I ECERR Q
89 S DQTIME=ECQDT
90 I ECPTYP="P" D Q
91 . S ECV="ECRTN^ECRN^ECRD",ECROU=$S(ECRTN="I":"LISTI",1:"PRT")_"^ECDSS1"
92 . S ECDESC="Event Capture National Procedure Report",ECDIP=1
93 . ;S ECSAVE("IO*")=""
94 .D QUEDIP D @$S(ECRTN="I":"LISTI^ECDSS1",1:"PRT^ECDSS1")
95 D CLOSE^%ZISH(ECDIRY_ECFILER)
96 S %ZIS("HFSNAME")=ECDIRY_ECFILER,%ZIS("HFSMODE")="W",IOP="HFS"
97 D @$S(ECRTN="I":"LISTI^ECDSS1",1:"PRT^ECDSS1")
98 Q
99ECDSS3 ;Category Reports for RPC Call
100 ; Variables passed in
101 ; ECRTN - Category Procedure Report
102 ; (A-active, I-inactive or B-oth)
103 ;
104 ; Variable return
105 ; ^TMP($J,"ECRPT",n)=report output or to print device.
106 N ECV,ECDIP,DQTIME
107 S ECV="ECRTN" D REQCHK^ECRRPT(ECV) I ECERR Q
108 S DQTIME=ECQDT
109 I ECPTYP="P" D Q
110 . S ECV="ECRTN",ECROU="PRINT^ECDSS3"
111 . S ECDESC="Event Capture Category Reports"
112 . D QUEDIP D PRINT^ECDSS3
113 D CLOSE^%ZISH(ECDIRY_ECFILER)
114 S %ZIS("HFSNAME")=ECDIRY_ECFILER,%ZIS("HFSMODE")="W",IOP="HFS"
115 D PRINT^ECDSS3
116 Q
117QUEDIP ;Queue when using DIP
118 N DIC,X,Y
119 D I Y=-1 S ECERR=1 Q
120 . S DIC(0)="MN",X=ECDEV,DIC="^%ZIS(1," D ^DIC
121 . S:+Y>0 IOP="Q;"_$P(Y,U,2)
122 . S Y=ECQDT X ^DD("DD") S DQTIME=Y
123 Q
124ECSUM ;Print Category and Procedure Summary (Report) for RPC Call
125 ; Variables passed in
126 ; ECL - Location to report (1)
127 ; ECD - DSS Unit to report (1 or ALL), If ECD'="ALL" then ECC
128 ; ECC - Category (1 or ALL) (optional)
129 ; ECRTN - Event Code Screen (Active, Inactive or Both)
130 ;
131 ; Variable return
132 ; ^TMP($J,"ECRPT",n)=report output or to print device.
133 N ECV,ECDN,ECCN,ECROU,ECSAVE,ECDESC,ECLN,ECS,ECJLP,ECSN,ECALL,DIC,X,Y
134 N ECSCN
135 S (ECJLP,ECALL)=0,ECV="ECL^ECD^ECRTN" D REQCHK^ECRRPT(ECV) I ECERR Q
136 S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC D:Y<0 Q:ECERR S ECLN=$P(Y,U,2)
137 . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
138 S ECSCN=ECRTN D I ECERR S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q
139 . I ECD="ALL" S ECALL=1 Q
140 . K DIC S DIC=724,DIC(0)="QNMZX",X=ECD D ^DIC I Y<0 S ECERR=1 Q
141 . S ECDN=$P(Y,U,2)_$S($P($G(^ECD(+ECD,0)),"^",6):" **Inactive**",1:"")
142 . S ECS=+$P(^ECD(ECD,0),"^",2),ECJLP=+$P(^(0),"^",11)
143 . S ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
144 . I 'ECJLP S ECC=0,ECCN="None"
145 I ECALL D PXRUN Q
146 S ECV="ECC" D REQCHK^ECRRPT(ECV) I ECERR Q
147 D I ECERR S ^TMP("ECMSG",$J)="1^Invalid Category." Q
148 . I (ECC="ALL")!(ECC=0) Q
149 . K DIC S DIC=726,DIC(0)="QNMZX",X=ECC D ^DIC I Y<0 S ECERR=1 Q
150 . S ECCN=$P(Y,U,2)
151PXRUN I ECPTYP="P" D Q
152 . S ECV="ECL^ECLN^ECALL^ECSCN",ECROU="START^ECSUM"
153 . I 'ECALL S ECV=ECV_"^ECD^ECC^ECLN^ECSN^ECDN^ECJLP^ECCN^ECSCN"
154 . S ECDESC="EC Print Category and Procedure Summary"
155 . D QUEUE^ECRRPT
156 U IO D START^ECSUM
157 Q
158ECNTPCE ;ECS Records Failing Transmission to PCE
159 ; Variables passed in
160 ; ECSD - Start Date or Report
161 ; ECED - End Date or Report
162 ;
163 ; Variable return
164 ; ^TMP($J,"ECRPT",n)=report output or to print device.
165 N ECV,ECDATE,ECROU,ECDESC
166 S ECV="ECSD^ECED" D REQCHK^ECRRPT(ECV) I ECERR Q
167 D DATECHK^ECRRPT(.ECSD,.ECED)
168 S ECSD=ECSD-.0001,ECED=ECED+.9999
169 I ECPTYP="P" D Q
170 . S ECV="ECSD^ECED^ECDATE",ECROU="START^ECNTPCE"
171 . S ECDESC="ECS Records Failing Transmission to PCE Report"
172 . D QUEUE^ECRRPT
173 D START^ECNTPCE
174 Q
175ECSCPT ;Event Code Screens with CPT Codes
176 ; Variables passed in
177 ; ECL - Location to report (1)
178 ; ECD - DSS Unit to report (1 or ALL), If ECD'="ALL" then ECC
179 ; ECC - Category (1 or ALL) (optional)
180 ; ECCPT - CPT Codes to Display (Active, Inactive or Both)
181 ;
182 ; Variable return
183 ; ^TMP($J,"ECRPT",n)=report output or to print device.
184 N ECV,ECDN,ECCN,ECROU,ECSAVE,ECDESC,ECLN,ECS,ECJLP,ECALL,DIC,X,Y
185 S (ECJLP,ECALL)=0,ECV="ECL^ECD^ECCPT" D REQCHK^ECRRPT(ECV) I ECERR Q
186 S DIC=4,DIC(0)="QNZX",X=ECL D ^DIC D:Y<0 Q:ECERR S ECLN=$P(Y,U,2)
187 . S ^TMP("ECMSG",$J)="1^Invalid Location.",ECERR=1
188 D I ECERR S ^TMP("ECMSG",$J)="1^Invalid DSS Unit." Q
189 . I ECD="ALL" S ECALL=1 Q
190 . K DIC S DIC=724,DIC(0)="QNMZX",X=ECD D ^DIC I Y<0 S ECERR=1 Q
191 . S ECDN=$P(Y,U,2)_$S($P($G(^ECD(+ECD,0)),"^",6):" **Inactive**",1:"")
192 . S ECJLP=+$P(^ECD(ECD,0),"^",11)
193 . I 'ECJLP S ECC=0,ECCN="None"
194 I ECALL D CPTRUN Q
195 S ECV="ECC" D REQCHK^ECRRPT(ECV) I ECERR Q
196 D I ECERR S ^TMP("ECMSG",$J)="1^Invalid Category." Q
197 . I (ECC="ALL")!(ECC=0) Q
198 . K DIC S DIC=726,DIC(0)="QNMZX",X=ECC D ^DIC I Y<0 S ECERR=1 Q
199 . S ECCN=$P(Y,U,2)
200CPTRUN I ECPTYP="P" D Q
201 . S ECV="ECL^ECLN^ECALL^ECCPT",ECROU="START^ECSCPT"
202 . I 'ECALL S ECV=ECV_"^ECD^ECC^ECDN^ECJLP^ECCN"
203 . S ECDESC="Event Code Screens with CPT Codes"
204 . D QUEUE^ECRRPT
205 U IO D START^ECSCPT
206 Q
207ECINCPT ;National/Local Procedure Codes with Inactive CPT Reports for RPC Call
208 ; Variables passed in
209 ; NONE - No input variables
210 ;
211 ; Variable return
212 ; ^TMP($J,"ECRPT",n)=report output or to print device.
213 N ECV,ECL,ECDESC,ECROU,DQTIME,ECPG
214 S ECPG=1
215 I ECPTYP="P" D Q
216 . S ECROU="START^ECINCPT",ECV="ECL",ECL=""
217 . S ECDESC="National/Local Procedure Codes with Inactive CPT"
218 . D QUEUE^ECRRPT
219 U IO D START^ECINCPT
220 Q
Note: See TracBrowser for help on using the repository browser.