source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECV3RPC.m@ 891

Last change on this file since 891 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 6.4 KB
Line 
1ECV3RPC ;ALB/ACS;Event Capture Spreadsheet Data Validation ;Oct 13, 2000
2 ;;2.0; EVENT CAPTURE ;**25,47,49,61,72**;8 May 96
3 ;
4 ;-----------------------------------------------------------------------
5 ; Validates the following Event Capture Spreadsheet Upload fields:
6 ; 1. DSS UNIT IEN, DSS UNIT NUMBER, DSS UNIT NAME
7 ; 2. ORDERING SECTION
8 ; 3. PROCEDURE CODE
9 ; 4. CATEGORY
10 ;
11 ;-----------------------------------------------------------------------
12 ;
13 ;--Set up error flag
14 S ECERRFLG=0
15 ;
16 ;--GET DSS Unit IEN--
17 S ECDSSIEN=""
18 ; -Check for DSS Unit IEN first
19 I ECUNITV'="",(ECUNITV'=+ECUNITV) D
20 . S ECERRMSG=$P($T(DSS1^ECV3RPC),";;",2)
21 . S ECCOLERR=ECUNITPC
22 . D ERROR
23 I ECUNITV,'ECERRFLG,$D(^ECD(ECUNITV,0)) S ECDSSIEN=ECUNITV
24 I ECUNITV,'ECERRFLG,'$D(^ECD(ECUNITV,0)) D
25 . ; DSS unit ien not found on VistA
26 . S ECERRMSG=$P($T(DSS1^ECV3RPC),";;",2)
27 . S ECCOLERR=ECUNITPC
28 . D ERROR
29 . Q
30 ; -Check for DSS Unit Number
31 I ECDCMV'="",'$D(^ECD("C",ECDCMV)) D
32 . ; DSS Unit Number not found on VistA
33 . S ECERRMSG=$P($T(DSS2^ECV3RPC),";;",2)
34 . S ECCOLERR=ECDCMPC
35 . D ERROR
36 I 'ECERRFLG,ECDCMV'="",$D(^ECD("C",ECDCMV)) S ECDSSIEN=$O(^ECD("C",ECDCMV,0))
37 ;Check if the next record is a match
38 I 'ECERRFLG,'ECDSSIEN,ECDCMV'="",$D(^ECD("C",ECDCMV)) D
39 . S ECDSSIEN=$O(^ECD("C",ECDCMV,0))
40 . I '$D(^ECD("C",ECDCMV)) D
41 . . ; DSS Unit Number not found on VistA
42 . . S ECERRMSG=$P($T(DSS2^ECV3RPC),";;",2)
43 . . S ECCOLERR=ECDCMPC
44 . . D ERROR
45 . . Q
46 ; -Check for DSS Unit Name
47 I ECDSSV'="",'$D(^ECD("B",ECDSSV)) D
48 . S ECERRMSG=$P($T(DSS3^ECV3RPC),";;",2)
49 . S ECCOLERR=ECDSSPC
50 . D ERROR
51 ;
52 I 'ECERRFLG,'ECDSSIEN,ECDSSV'="",$D(^ECD("B",ECDSSV)) S ECDSSIEN=$O(^ECD("B",ECDSSV,0))
53 I 'ECERRFLG,'ECDSSIEN,ECDSSV'="",'$D(^ECD("B",ECDSSV)) D
54 . N ECNXTDSS
55 . S ECNXTDSS=$O(^ECD("B",ECDSSV))
56 . I ECDSSV=$E(ECNXTDSS,1,$L(ECDSSV)) S ECDSSIEN=$O(^ECD("B",ECNXTDSS,0))
57 . ;
58 . I ECDSSV'=$E(ECNXTDSS,1,$L(ECDSSV)) D
59 . . ; DSS unit name not found on VistA
60 . . S ECERRMSG=$P($T(DSS3^ECV3RPC),";;",2)
61 . . S ECCOLERR=ECDSSPC
62 . . D ERROR
63 . . Q
64 . Q
65 ;
66 ;--Validate Ordering section or derive from DSS Unit IEN--
67 I ECOSV'="" D
68 . S ECOSIEN=$O(^ECC(723,"B",ECOSV,0))
69 . I ECOSIEN="" D
70 . . ; Ordering Section "B" x-ref doesn't exist
71 . . S ECERRMSG=$P($T(ORDSEC1^ECV3RPC),";;",2)
72 . . S ECCOLERR=ECOSPC
73 . . D ERROR
74 . . Q
75 . Q
76 I ECOSV="" D
77 . I 'ECDSSIEN D
78 . . ; Unable to derive Ordering section from DSS Unit
79 . . S ECERRMSG=$P($T(ORDSEC2^ECV3RPC),";;",2)
80 . . S ECCOLERR=ECOSPC
81 . . D ERROR
82 . . Q
83 . I ECDSSIEN D
84 . . S ECOSIEN=$P(^ECD(ECDSSIEN,0),U,3)
85 . . I ECOSIEN="" D
86 . . . ; Unable to derive Ordering section from DSS Unit
87 . . . S ECERRMSG=$P($T(ORDSEC2^ECV3RPC),";;",2)
88 . . . S ECCOLERR=ECOSPC
89 . . . D ERROR
90 . . . Q
91 . . Q
92 ;
93 ;--Procedure must be a National Procedure, Local Procedure, --
94 ;--or a CPT code, and the EC Event Code Screen must be active --
95 N ECFOUND,ECPI,ECDT
96 S ECERRFLG=0,ECFOUND=0
97 S %DT="XST",X=$G(ECENCV,"NOW") D ^%DT S ECDT=+Y
98 ; Check for National Procedure code (D x-ref)
99 I $D(^EC(725,"D",ECPROCV)) D
100 . S ECPROCV=$O(^EC(725,"D",ECPROCV,0))_";EC(725,"
101 . S ECPI=$P($G(^EC(725,ECPROCV,0)),"^",5)
102 . I ECPI="" S ECFOUND=1 Q
103 . S ECPI=$$CPT^ICPTCOD(ECPI,ECDT) I +ECPI>0,$P(ECPI,"^",7) S ECFOUND=1
104 ; Check for local procedure code (DL x-ref)
105 I 'ECFOUND,$D(^EC(725,"DL",ECPROCV)) D
106 . S ECPROCV=$O(^EC(725,"DL",ECPROCV,0))_";EC(725,"
107 . S ECPI=$P($G(^EC(725,ECPROCV,0)),"^",5)
108 . I ECPI="" S ECFOUND=1 Q
109 . S ECPI=$$CPT^ICPTCOD(ECPI,ECDT) I +ECPI>0,$P(ECPI,"^",7) S ECFOUND=1
110 ; Check for CPT code (B x-ref)
111 I 'ECFOUND S ECPI=$$CPT^ICPTCOD(ECPROCV,ECDT) I +ECPI>0,$P(ECPI,"^",7) D
112 . S ECPROCV=$P(ECPI,"^")_";ICPT("
113 . S ECFOUND=1
114 ;
115 I 'ECFOUND D
116 . ; Invalid procedure code
117 . S ECERRMSG=$P($T(PROC1^ECV3RPC),";;",2)
118 . S ECCOLERR=ECPROCPC
119 . D ERROR
120 . Q
121 ;
122 ; -Category must exist on the Event Capture Category file
123 I ECCATV="" S ECCATIEN=0
124 I ECCATV'="" D
125 . I $D(^EC(726,"B",ECCATV)) S ECCATIEN=$O(^EC(726,"B",ECCATV,0))
126 . I '$D(^EC(726,"B",ECCATV)) D
127 . . ; B cross reference not found for category
128 . . S ECERRMSG=$P($T(CAT1^ECV3RPC),";;",2)
129 . . S ECCOLERR=ECCATPC
130 . . D ERROR
131 . . Q
132 ;
133 ; -check for active Event Code screen
134 N ECEVNT,ECSNODE,ECSDATA,ECSFOUND
135 I 'ECERRFLG D
136 . S ECEVNT=ECSTAV_"-"_ECDSSIEN_"-"_ECCATIEN_"-"_ECPROCV
137 . S (ECSNODE,ECSFOUND)=0
138 . F S ECSNODE=$O(^ECJ(ECSNODE)) Q:ECSNODE="" D
139 . . S ECSDATA=$G(^ECJ(ECSNODE,0))
140 . . I ECEVNT=$P(ECSDATA,U,1) D
141 . . . S ECSFOUND=1
142 . . . I $P(ECSDATA,U,2)'="" D
143 . . . . ; Event Code screen inactive
144 . . . . S ECERRMSG=$P($T(PROC2^ECV3RPC),";;",2)
145 . . . . S ECCOLERR=ECPROCPC
146 . . . . D ERROR
147 . . . . Q
148 . . . Q
149 . . Q
150 . Q
151 ;
152 ;Generate error if event code screen not found
153 I 'ECERRFLG,'ECSFOUND,ECDSSIEN D
154 . ; Event Code screen not found
155 . S ECERRMSG=$P($T(PROC3^ECV3RPC),";;",2)
156 . S ECCOLERR=ECPROCPC
157 . D ERROR
158 . Q
159 ;
160 I 'ECERRFLG,'ECFILDUP D
161 .;Check for duplicate uploaded record base on Loc_DSS Unit_Category_Proc
162 .;Date_Procedure
163 . N ECDUP,ECNAM,ECPNAM,ECI,ECX,Y,ECPRV,ECPROV
164 . S (ECDA,ECDUP)=0
165 . F S ECDA=$O(^ECH("ADT",ECSTAV,ECSSNIEN,ECDSSIEN,ECDT,ECDA)) Q:'ECDA D I ECDUP Q
166 . . S ECX=$G(^ECH(ECDA,0)) I ECX="" Q
167 . . I $P(ECX,U,8)'=ECCATIEN Q
168 . . I $P(ECX,U,9)'=ECPROCV Q
169 . . S ECPNAM="",ECDUP=1
170 . . K ECPRV S ECPROV=$$GETPRV^ECPRVMUT(ECDA,.ECPRV)
171 . . F ECI=1:1:3 S Y=$O(ECPRV("")) I Y'="" D
172 . . . S ECNAM=$P(ECPRV(Y),U,2) K ECPRV(Y)
173 . . . S ECPNAM=ECPNAM_" "_$P(ECNAM,",")_","_$E($P(ECNAM,",",2))
174 . . S ECERRMSG="**DUPLICATE** "
175 . . S ECERRMSG=ECERRMSG_" Clinic: "_$$GET1^DIQ(44,$P(ECX,U,19),.01,"I")
176 . . S ECERRMSG=ECERRMSG_" Order Sect: "_$$GET1^DIQ(723,$P(ECX,U,12),.01,"I")
177 . . S ECERRMSG=ECERRMSG_" Provider: "_ECPNAM
178 . . S ECNAM=$$GET1^DIQ(200,$P(ECX,U,13),.01,"I")
179 . . S ECERRMSG=ECERRMSG_" Entered: "_$P(ECNAM,",")_","_$E($P(ECNAM,",",2))
180 . . S ECCOLERR=ECSTAPC ;(???)
181 . . D ERROR
182 Q
183ERROR ;--Set up array entry to contain the following:
184 ;1. record number
185 ;2. column number on spreadsheet containing the record number
186 ;3. column number on spreadsheet containing the data in error
187 ;4. error message
188 ;
189 S ECINDEX=ECINDEX+1
190 S RESULTS(ECINDEX)=ECRECV_"^"_ECRECPC_"^"_ECCOLERR_"^"_ECERRMSG_"^"
191 S ECERRFLG=1
192 Q
193 ;
194DSS1 ;;Invalid DSS Unit IEN
195DSS2 ;;Invalid DSS Unit Number
196DSS3 ;;Invalid DSS Unit Name
197ORDSEC1 ;;Ordering Section "B" x-ref not on Med Specialty file(#723)
198ORDSEC2 ;;Unable to derive Ordering Section from DSS Unit
199PROC1 ;;Procedure/CPT invalid
200PROC2 ;;Procedure/CPT invalid for this Station and DSS Unit
201PROC3 ;;Event Code screen not found
202CAT1 ;;Category "B" x-ref not on EC Category file(#726)
Note: See TracBrowser for help on using the repository browser.