source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECV2RPC.m@ 1608

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

initial load of WorldVistAEHR
File size: 5.0 KB
RevLine 
[613]1ECV2RPC ;ALB/ACS;Event Capture Spreadsheet Validation;07 Aug 01
2 ;;2.0; EVENT CAPTURE ;**25,30,49**;8 May 96
3 ;
4 ;-----------------------------------------------------------------------
5 ; Validates the following Event Capture spreadsheet fields:
6 ; 1. Location
7 ; 2. Patient SSN
8 ; 3. Patient Name
9 ;-----------------------------------------------------------------------
10 ;=======================================================================
11 ;MODIFICATIONS
12 ;08/2001 EC*2.0*30 Updated the error message for Location
13 ;=======================================================================
14 ;
15 ;--Set up error flag
16 S ECERRFLG=0
17 ;
18 ;--Location must be on the Institution file
19 I '$D(^DIC(4,ECSTAV)),'$D(^DIC(4,"D",ECSTAV)) D
20 . ; Location not on the VistA file
21 . S ECERRMSG=$P($T(STA1^ECV2RPC),";;",2)
22 . S ECCOLERR=ECSTAPC
23 . D ERROR
24 . Q
25 ;Check for multiple station number entries
26 N LOC,C,STR
27 S (LOC,C)=0,STR=""
28 F S LOC=$O(^DIC(4,"D",ECSTAV,LOC)) Q:'LOC S C=C+1 D
29 . S LOC(LOC)=ECSTAV_", Location IEN "_LOC_", "_$P(^DIC(4,LOC,0),"^")
30 I C>1 S LOC=0 F S LOC=$O(LOC(LOC)) Q:'LOC D
31 . S ECERRMSG=$P($T(STA2^ECV2RPC),";;",2)_LOC(LOC)
32 . S ECCOLERR=ECSTAPC
33 . D ERROR
34 I C=1,$D(^DIC(4,"D",ECSTAV)) S ECSTAV=$O(^DIC(4,"D",ECSTAV,"")) ;get ien
35 ;
36 ;--Patient SSN must be on the Patient file--
37 N ECNAME4,ECNAME3,ECNAME2,ECNAME1,ECVNAME4,ECVNAME3
38 N ECVNAME2,ECVNAME1,ECVNAME,ECSSNNUM
39 S (ECSSNIEN,ECERRFLG)=0,ECSSNNUM=+ECSSNV
40 I $L(ECSSNNUM)>9!$L(ECSSNV)>10 D
41 . ; User has entered an SSN that is too long
42 . S ECERRMSG=$P($T(SSN5^ECV2RPC),";;",2)
43 . S ECCOLERR=ECSSNPC
44 . D ERROR
45 . Q
46 I 'ECERRFLG D
47 . ; -add leading zeros if needed
48 . I $L(ECSSNNUM)<9 S ECSSNV=$E("000000000",1,9-$L(ECSSNNUM))_ECSSNNUM
49 . I $L(ECSSNV)>10 D
50 . . ; User has entered an invalid SSN
51 . . S ECERRMSG=$P($T(SSN5^ECV2RPC),";;",2)
52 . . S ECCOLERR=ECSSNPC
53 . . D ERROR
54 . . Q
55 . I 'ECERRFLG,$L(ECSSNV)=10 D
56 . . I $E(ECSSNV,10,10)'="P" D
57 . . . ; Invalid SSN
58 . . . S ECERRMSG=$P($T(SSN5^ECV2RPC),";;",2)
59 . . . S ECCOLERR=ECSSNPC
60 . . . D ERROR
61 . . Q
62 . I 'ECERRFLG,'$D(^DPT("SSN",ECSSNV)) D
63 . . ; No SSN x-ref on patient file
64 . . S ECERRMSG=$P($T(SSN1^ECV2RPC),";;",2)
65 . . S ECCOLERR=ECSSNPC
66 . . D ERROR
67 . . Q
68 . Q
69 I 'ECERRFLG D
70 . ; -get SSN IEN
71 . S ECSSNIEN=$O(^DPT("SSN",ECSSNV,0))
72 . I 'ECSSNIEN D
73 . . S ECERRMSG=$P($T(SSN2^ECV2RPC),";;",2)
74 . . S ECCOLERR=ECSSNPC
75 . . D ERROR
76 . . Q
77 . Q
78 I 'ECERRFLG,'$D(^DPT(ECSSNIEN,0)) D
79 . ; SSN record not found
80 . S ECERRMSG=$P($T(SSN3^ECV2RPC),";;",2)
81 . S ECCOLERR=ECSSNPC
82 . D ERROR
83 . Q
84 ;
85 I 'ECERRFLG D
86 . ; -Compare patient file ssn to patient ssn
87 . S ECVSSN=$P(^DPT(ECSSNIEN,0),U,9)
88 . I ECVSSN'=ECSSNV D
89 . . ; Spreadsheet ssn doesn't match vista
90 . . S ECERRMSG=$P($T(SSN4^ECV2RPC),";;",2)
91 . . S ECCOLERR=ECSSNPC
92 . . D ERROR
93 . . Q
94 . Q
95 ;--Patient Name must match VistA name--
96 I 'ECERRFLG D
97 . S ECVNAME=$P(^DPT(ECSSNIEN,0),U,1)
98 . I '$D(ECVNAME) D
99 . . ; Patient name missing from VistA file
100 . . S ECERRMSG=$P($T(NAME1^ECV2RPC),";;",2)
101 . . S ECCOLERR=ECSSNPC
102 . . D ERROR
103 . . Q
104 . Q
105 I 'ECERRFLG,'ECDECPAT D
106 . N DFN,VADM S DFN=ECSSNIEN D 2^VADPT I +VADM(6) D
107 . . S ECERRMSG="WARNING: [PATIENT DIED ON "_$P(VADM(6),U,2)_"]"
108 . . S ECCOLERR=ECSSNPC
109 . . D ERROR
110 I 'ECERRFLG D
111 . S ECVNAME4=$E(ECVNAME,1,4),ECNAME4=$E(ECPATV,1,4)
112 . S ECVNAME3=$E(ECVNAME,1,3),ECNAME3=$E(ECPATV,1,3)
113 . S ECVNAME2=$E(ECVNAME,1,2),ECNAME2=$E(ECPATV,1,2)
114 . S ECVNAME1=$E(ECVNAME,1,1),ECNAME1=$E(ECPATV,1,1)
115 . I ECNAME1'=ECVNAME1 D
116 . . ; First char of name doesn't match
117 . . S ECERRMSG=$P($T(NAME5^ECV2RPC),";;",2)
118 . . S ECCOLERR=ECPATLPC
119 . . D ERROR
120 . . Q
121 . I 'ECERRFLG,ECNAME2'=ECVNAME2 D
122 . . ; First 2 chars of name doesn't match
123 . . S ECERRMSG=$P($T(NAME2^ECV2RPC),";;",2)
124 . . S ECCOLERR=ECPATLPC
125 . . D ERROR
126 . . Q
127 . I 'ECERRFLG,(ECNAME3'=ECVNAME3) D
128 . . ; First 3 chars of name doesn't match
129 . . S ECERRMSG=$P($T(NAME3^ECV2RPC),";;",2)
130 . . S ECCOLERR=ECPATLPC
131 . . D ERROR
132 . . Q
133 . I 'ECERRFLG,(ECNAME4'=ECVNAME4) D
134 . . ; First 4 chars of name doesn't match
135 . . S ECERRMSG=$P($T(NAME4^ECV2RPC),";;",2)
136 . . S ECCOLERR=ECPATLPC
137 . . D ERROR
138 . . Q
139 . Q
140 Q
141 ;
142ERROR ;--Set up array entry to contain the following:
143 ;1. record number
144 ;2. column number on spreadsheet containing the record number
145 ;3. column number on spreadsheet containing the data in error
146 ;4. error message
147 ;
148 S ECINDEX=ECINDEX+1
149 S RESULTS(ECINDEX)=ECRECV_"^"_ECRECPC_"^"_ECCOLERR_"^"_ECERRMSG_"^"
150 S ECERRFLG=1
151 Q
152 ;
153 ;Error messages:
154 ;
155STA1 ;;Location not on institution file(#4)
156STA2 ;;Multiple entries found for Location/Station #
157SSN1 ;;No SSN x-ref on patient file(#2)
158SSN2 ;;No SSN entry on patient file(#2)
159SSN3 ;;No internal entry on patient file(#2) for ssn x-ref
160SSN4 ;;SSN doesn't match SSN on patient file(#2)
161SSN5 ;;SSN invalid
162NAME1 ;;Patient Name is missing from VistA patient file(#2)
163NAME2 ;;First 2 chars of patient last name don't match VistA
164NAME3 ;;First 3 chars of patient last name don't match VistA
165NAME4 ;;First 4 chars of patient last name don't match VistA
166NAME5 ;;First char of patient last name doesn't match VistA
Note: See TracBrowser for help on using the repository browser.