source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEDE5.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: 7.9 KB
Line 
1IBCNEDE5 ;DAOU/DAC - IIV DATA EXTRACTS ;15-OCT-2002
2 ;;2.0;INTEGRATED BILLING;**184,271**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q ; no direct calls allowed
6 ;
7SIDCHK(PIEN,DFN,BSID,SIDARRAY,FRESHDT) ; Checks the flag settings of 'Identification
8 ; Requires Subscriber ID' and 'Use SSN as Subscriber ID'. The function
9 ; returns a "^" delimited string. The first value is between 1 and 5
10 ; telling the calling program what action(s) it should perform. The
11 ; 2nd piece indicates the Subcriber ID that the calling program should
12 ; use for setting the Subscriber IDs in the IIV Transmission Queue file
13 ; (365.1). The calling program is to address the blank Sub IDs and
14 ; make sure the data extract does not exceed the max extract number.
15 ;
16 ; PIEN - Payer's IEN (file 365.12)
17 ; DFN - Patient's IEN (file 2)
18 ; INREC - Insurance IEN of Patients record (subfile 2.312)
19 ; BSID - Subscriber ID from buffer file (file 355.3 field )
20 ; SIDARRAY - Array of active subscribers - may be subscripted by SSN
21 ; FRESHDT - Freshness Date - used for checking verified date
22 ;
23 ; Logic to follow:
24 ;
25 ; Id. Req.| Use SSN | Sub ID|Action|
26 ; Sub ID | as Sub ID| found | # | Create
27 ; ________|__________|_______|______|________
28 ; YES - YES 1 1 Verification TQ entry w/ Sub ID
29 ; YES YES NO 2 1 Ver. TQ entry, use SSN as Sub ID
30 ; YES NO NO 3 new buffer entry or modify existing
31 ; saying manual verification required
32 ; NO NO NO 4 1 Ver. TQ entry w/ blank Sub ID
33 ; NO YES NO 5 2 Ver. TQ entries, 1 w/ SSN as Sub
34 ; ID and other w/ blank Sub ID
35 ;
36 N SIDACT,SID,APPIEN,SIDSTR,SIDREQ,SIDSSN,SSN
37 N INSSTR,INSSTR1,SYMBOL,EXP,SUBID,SUBIDS,SIDCNT,INREC,MVER,VFLG
38 ;
39 S FRESHDT=$G(FRESHDT),VFLG=0
40 ;
41 I $G(BSID)'="" D G SIDCHKX
42 . S SID=BSID,(SIDACT,SIDCNT)=1
43 . S SIDARRAY($$STRIP(SID,,DFN)_"_")=""
44 S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
45 S SIDSTR=$G(^IBE(365.12,PIEN,1,APPIEN,0))
46 S SIDREQ=$P(SIDSTR,U,8)
47 S SIDSSN=$P(SIDSTR,U,9)
48 ;
49 S INSSTR="",SIDCNT=0,INREC=$O(^DPT(DFN,.312,0)) S:'INREC INREC=1
50 ;
51 I $D(BSID),BSID="" G SIDC1
52 I $G(^DPT(DFN,.312,INREC,0)) F D Q:'INREC
53 . S INSSTR=$G(^DPT(DFN,.312,INREC,0))
54 . S INSSTR1=$G(^DPT(DFN,.312,INREC,1))
55 . S SYMBOL=$$INSERROR^IBCNEUT3("I",+INSSTR)
56 . I $P(SYMBOL,U)="" D ; no IIV related error w/ ins. company
57 .. I PIEN'=$P(SYMBOL,U,2) Q ; wrong payer ien
58 .. S SUBID=$P(INSSTR,U,2)
59 .. I SUBID="" Q ; missing Subscriber ID
60 .. I $P(INSSTR,U,8)>DT Q ; future effective date
61 .. S EXP=$P(INSSTR,U,4) I EXP,EXP<DT Q ; expired
62 .. S MVER=$P(INSSTR1,U,3) ; last verified date
63 .. I MVER'="",FRESHDT'="",MVER>FRESHDT S VFLG=1 Q ; verified recently
64 .. S SUBIDS=$$STRIP(SUBID,,DFN)
65 .. I $D(SIDARRAY(SUBIDS_"_"_INREC)) Q ; already in the array
66 .. S SIDARRAY(SUBIDS_"_"_INREC)="",SIDCNT=SIDCNT+1
67 . S INREC=$O(^DPT(DFN,.312,INREC))
68 . Q
69 ;
70 I SIDCNT S SIDACT=1 G SIDCHKX
71 I 'SIDCNT,VFLG S SIDACT=1 G SIDCHKX
72SIDC1 I SIDREQ,SIDSSN S SIDACT=2 D SSN(DFN) G SIDCHKX
73 I SIDREQ,'SIDSSN S SIDACT=3 G SIDCHKX
74 I 'SIDREQ,'SIDSSN S SIDACT=4 G SIDCHKX
75 I 'SIDREQ,SIDSSN S SIDACT=5 D SSN(DFN)
76 ;
77SIDCHKX ; EXIT POINT
78 ;
79 Q SIDACT_U_SIDCNT
80 ;
81SSN(DFN) ; Get Patient SSN and update SIDARRAY, if needed
82 S SSN=$$GETSSN(DFN)
83 N SSNS
84 S SSNS=$$STRIP(SSN,1,DFN)
85 I $P($O(SIDARRAY(SSNS_"_")),"_")=SSNS Q
86 I SSNS'="",'$D(SIDARRAY(SSNS_"_")) S SIDARRAY(SSNS_"_")="",SIDCNT=SIDCNT+1
87 Q
88 ;
89GETSSN(DFN) ; Get Patient SSN
90 Q:'$G(DFN) ""
91 Q $P($G(^DPT(DFN,0)),U,9)
92 ;
93STRIP(ID,SS,DFN) ; Strip dashes and spaces if ssn
94 ; ID can be ssn or subid
95 ; if SS, ssn is being passed
96 N SSN,IDS,IDB
97 S SS=$G(SS)
98 ; If a ssn is passed, strip dashes and spaces
99 I SS Q $TR(ID,"- ")
100 ; If not ssn format, do not strip
101 S IDB=$TR(ID," ")
102 I IDB'?3N1"-"2N1"-"4N,IDB'?9N Q ID
103 ; Compare w/SSN - if it matches, strip dashes and spaces
104 S IDS=$TR(ID,"- ")
105 S SSN=$TR($$GETSSN(DFN),"- ")
106 I SSN=IDS Q IDS
107 Q ID
108 ;
109SIDCHK2(DFN,PIEN,SIDARRAY,FRESHDT) ;Checks the flag settings of
110 ; 'Identification Requires Subscriber ID' and 'Use SSN as Subscriber
111 ; ID'. The function returns a "^" delimited string. The first value
112 ; is between 1 and 8 telling the calling program what action(s) it
113 ; should perform. The 2nd piece indicates the number of unique
114 ; Subscriber IDs found for the patient/payer combo. In addition, a
115 ; local array of Subcriber IDs are passed back by reference that the
116 ; calling program should use for setting the Subscriber IDs in IIV
117 ; Transmission Queue file (#365.1). The calling program is to address
118 ; the blank Sub IDs and make sure the data extract does not exceed the
119 ; max extract number.
120 ;
121 ; PIEN - Payer's IEN (file 365.12)
122 ; DFN - Patient's IEN (file 2)
123 ; SIDARRAY - Local array passed by reference. This function returns
124 ; the array populated with the possible Subscriber IDs for
125 ; that patient/payer combination.
126 ; FRESHDT - Freshness date used for checking last verified condition
127 ;
128 ; Logic to follow:
129 ;
130 ; Id. Req.| Use SSN | Sub ID|Action|
131 ; Sub ID | as Sub ID| found | # | Create
132 ; ________|__________|_______|______|________
133 ; YES YES YES 1 1 Identification TQ entry w/ SSN
134 ; as Sub ID, & 1 Iden. TQ entry for
135 ; each unique old Sub ID
136 ; YES YES NO 2 1 Iden. TQ entry, use SSN as Sub ID
137 ; YES NO YES 3 1 Iden. TQ entry for each unique
138 ; old Sub ID
139 ; YES NO NO 4 No TQ entries (may flag as error)
140 ; NO NO YES 5 1 Iden. TQ entry w/ blank Sub ID,
141 ; & 1 Iden. TQ entry for each unique
142 ; old Sub ID
143 ; NO NO NO 6 1 Iden. TQ entry w/ blank Sub ID
144 ; NO YES YES 7 1 Iden. TQ entry w/ blank Sub ID,
145 ; & 1 Iden. TQ entry w/ SSN as Sub
146 ; ID, & 1 Iden. TQ entry for each
147 ; unique old Sub ID
148 ; NO YES NO 8 2 Iden. TQ entries, 1 w/ SSN as Sub
149 ; ID and other w/ blank Sub ID
150 ;
151 N SIDACT,SID,APPIEN,SIDSTR,SIDREQ,SIDSSN,SSN,INSSTR,INSSTR1,INREC
152 N SYMBOL,SUBID,SUBIDS,SIDCNT,MVER,VFLG
153 ;
154 S FRESHDT=$G(FRESHDT),VFLG=0
155 S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
156 S SIDSTR=$G(^IBE(365.12,PIEN,1,APPIEN,0))
157 S SIDREQ=$P(SIDSTR,U,8)
158 S SIDSSN=$P(SIDSTR,U,9)
159 S INSSTR="",(SID,SIDCNT)=0,INREC=$O(^DPT(DFN,.312,0)) S:'INREC INREC=1
160 ;
161 I $G(^DPT(DFN,.312,INREC,0)) F D Q:'INREC!VFLG
162 . S INSSTR=$G(^DPT(DFN,.312,INREC,0))
163 . S INSSTR1=$G(^DPT(DFN,.312,INREC,1))
164 . S SYMBOL=$$INSERROR^IBCNEUT3("I",+INSSTR)
165 . I $P(SYMBOL,U)="" D ; no IIV related error w/ ins. company
166 .. I PIEN'=$P(SYMBOL,U,2) Q ; wrong payer ien
167 .. S SUBID=$P(INSSTR,U,2)
168 .. I SUBID="" Q ; missing Subscriber ID
169 .. S MVER=$P(INSSTR1,U,3) ; last verified date
170 .. I MVER'="",FRESHDT'="",MVER>FRESHDT S VFLG=1 Q ; verified recently
171 .. S SUBIDS=$$STRIP(SUBID,,DFN)
172 .. I $D(SIDARRAY(SUBIDS_"_")) Q ; already in the array
173 .. S SIDARRAY(SUBIDS_"_"_INREC)="",SID=1,SIDCNT=SIDCNT+1
174 . S INREC=$O(^DPT(DFN,.312,INREC))
175 ;
176 I VFLG K SIDARRAY S SIDCNT=0,SIDACT=4 G SIDCK2X
177 I SID,SIDREQ,SIDSSN S SIDACT=1 D SSN(DFN) G SIDCK2X
178 I 'SID,SIDREQ,SIDSSN S SIDACT=2 D SSN(DFN) G SIDCK2X
179 I SID,SIDREQ,'SIDSSN S SIDACT=3 G SIDCK2X
180 I 'SID,SIDREQ,'SIDSSN S SIDACT=4 G SIDCK2X
181 I SID,'SIDREQ,'SIDSSN S SIDACT=5 G SIDCK2X
182 I 'SID,'SIDREQ,'SIDSSN S SIDACT=6 G SIDCK2X
183 I SID,'SIDREQ,SIDSSN S SIDACT=7 D SSN(DFN) G SIDCK2X
184 I 'SID,'SIDREQ,SIDSSN S SIDACT=8 D SSN(DFN) G SIDCK2X
185 ;
186SIDCK2X ; EXIT POINT
187 ;
188 Q SIDACT_U_SIDCNT
189 ;
Note: See TracBrowser for help on using the repository browser.