source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP3.m@ 1638

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

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1IBCEP3 ;ALB/TMP - EDI UTILITIES for provider ID ;25-SEP-00
2 ;;2.0;INTEGRATED BILLING;**137,207,232,280,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5CUNEED(IBIFN,IBSEQ,IBPTYP,IBRET,IBEMC) ; Determine if care unit needed for
6 ; provider type and insurance company(s) on bill
7 ; IBIFN = ien of bill (file 399)
8 ; IBSEQ = specific COB sequence to check or null for check all
9 ; IBPTYP = the ien of the provider id type in file 355.97 or if null,
10 ; the default performing provider ID type for the ins co's.
11 ; IBRET = flag to return insurance ien (0) or file 355.97 ien (1)
12 ; IBEMC = no longer used
13 ;
14 ; Function returns care unit needed flag (0=not needed, 1=needed) ^
15 ; AND if IBSEQ="": primary ins or 355.97 ien if care unit needed ^
16 ; secondary ins or 355.97 ien if care unit needed ^
17 ; tertiary ins or 355.97 ien if care unit needed
18 ; (these would be '^' pieces 2,3,4)
19 ; if IBSEQ : IBSEQ seq ins or 355.97 ien if care unit needed
20 ; (this would be '^' piece 2)
21 ;
22 Q:$G(IBEMC) 0
23 N Q,Z,Z0,Z4,IB,IBCTYP,IBFTYP,IBQ,IBRX,IBPT
24 S (IBRX,IB)=0
25 S IBFTYP=$$FT^IBCEF(IBIFN),IBCTYP=$$INPAT^IBCEF(IBIFN,1)
26 S IBFTYP=$S(IBFTYP=3:1,1:2) S:IBCTYP'=1 IBCTYP=2
27 I IBCTYP=2 S IBRX=$$ISRX^IBCEF1(IBIFN) ; Outpatient pharmacy
28 S IBPT=$G(IBPTYP)
29 ;
30 S (Z,IBQ)=0
31 F D Q:IBQ
32 . I $G(IBSEQ) S Z=IBSEQ,IBQ=1 ; Only once for specific COB sequence
33 . I '$G(IBSEQ) S Z=Z+1,IBPTYP=IBPT I Z>3 S IBQ=1 Q ; Up to 3 times - all ins
34 . S Z0=$$INSSEQ^IBCEP1(IBIFN,Z),Z4=$G(^DIC(36,+Z0,4))
35 . I '$G(IBPTYP) S IBPTYP=+Z4
36 . I 'Z0!'IBPTYP S:'Z0 IBQ=1 Q
37 . S Q=+$$CAREUN(Z0,IBPTYP,IBFTYP,IBCTYP,IBRX)
38 . I Q S $P(IB,U,$S($G(IBSEQ):Z+1,1:2))=$S($G(IBRET):Q,1:Z0)
39 ;
40 I $TR(IB,"^0") S $P(IB,U)=1
41 Q IB
42 ;
43CAREUN(IBINS,IBPTYP,IBFTYP,IBCTYP,IBRX) ; Find ien (file 355.96) for care
44 ; unit for the combination of ins co, prov type, form type and
45 ; care type
46 ; IBINS = ien of ins co (file 36)
47 ; IBPTYP = ien of provider id type (file 355.97)
48 ; IBFTYP = form type (1=UB,2=1500)
49 ; IBCTYP = care type (1=inpat,2=outpat)
50 ; IBRX = 1 if outpat/Rx bill
51 ;
52 N IB
53 S IB=""
54 ;
55 I $G(IBRX) D
56 . N T
57 . S T=$O(^IBA(355.96,"AD",IBINS,IBFTYP,3,IBPTYP,0))
58 . I 'T S T=$O(^IBA(355.96,"AD",IBINS,0,3,IBPTYP,0))
59 . I T S IB=T
60 ;
61 I 'IB D ; Find from most specific to least specific
62 . I $O(^IBA(355.96,"AD",IBINS,IBFTYP,IBCTYP,IBPTYP,0)) S IB=+$O(^(0)) Q
63 . I $O(^IBA(355.96,"AD",IBINS,IBFTYP,0,IBPTYP,0)) S IB=+$O(^(0)) Q
64 . I $O(^IBA(355.96,"AD",IBINS,0,IBCTYP,IBPTYP,0)) S IB=+$O(^(0)) Q
65 . I $O(^IBA(355.96,"AD",IBINS,0,0,IBPTYP,0)) S IB=+$O(^(0)) Q
66 ;
67 Q IB
68 ;
69DISP(IBINS,IBTYPE) ; Return the name of the type of care unit needed
70 ; IBINS = ien of ins co (file 36)
71 ; IBTYPE = 2:PERFORMING PROVIDER ID
72 I $G(IBTYPE)'=2 Q ""
73 Q $P($G(^DIC(36,+IBINS,4)),U,9)
74 ;
75DELID(IBIFN,IBSEQ,IBX) ; Delete all provider data specific to an ins co
76 ; represented by the COB sequence IBSEQ for bill IBIFN
77 ; IBX = 1 if called from care unit prompt - don't delete value
78 N IBZ,IBDR,X,Y,Z0,Z1
79 S IBZ=0
80 Q:'$G(IBSEQ)!($G(IBSEQ)>3)
81 F S IBZ=$O(^DGCR(399,IBIFN,"PRV",IBZ)) Q:'IBZ S Z0=$G(^(IBZ,0)),Z1=$G(^(1)) D
82 . ; Delete provider id's
83 . I $P(Z0,U,4+IBSEQ)'="" S IBDR(399.0222,IBZ_","_IBIFN_",",(4+IBSEQ/100))="@"
84 . ; Delete provider id types
85 . I $P(Z0,U,11+IBSEQ)'="" S IBDR(399.0222,IBZ_","_IBIFN_",",(11+IBSEQ/100))="@"
86 . I $D(IBDR) D FILE^DIE(,"IBDR")
87 Q
88 ;
89SETID(IBIFN,IBSEQ) ; Default provider id for bill IBIFN and ins co for COB
90 ; sequence IBSEQ
91 N IBZ,X,Y,IBDR,IBT
92 S IBZ=0
93 Q ; No longer used as of patch 232
94 ;Q:'$G(IBSEQ)!($G(IBSEQ)>3)
95 ;F S IBZ=$O(^DGCR(399,IBIFN,"PRV",IBZ)) Q:'IBZ S Z0=$G(^(IBZ,0)),Z1=$G(^(1)) D
96 ;. ; Update provider id's if no care unit is needed
97 ;. I $P(Z0,U,2)'="" D
98 ;.. S Z=$$GETID^IBCEP2(IBIFN,2,$P(Z0,U,2),IBSEQ,.IBT)
99 ;.. I Z'="",IBT S IBDR(399.0222,IBZ_","_IBIFN_",",(4+IBSEQ/100))=Z,IBDR(399.0222,IBZ_","_IBIFN_",",(11+IBSEQ/100))=+IBT
100 ;. I $D(IBDR) D FILE^DIE(,"IBDR")
101 Q
102 ;
103ALLID(IBIFN,IBFLD,IBFUNC) ; If form type or care type (I/O/RX) changes,
104 ; determine new provider id values if possible and update them
105 ; this includes primary, secondary, tertiary id's
106 ; IBIFN = ien of claim (file 399)
107 ; IBFLD = ien of the field being changed when this call is made
108 ; (.19 = form type .25 = care type)
109 ; IBFUNC = 1 to add, 2 to delete
110 N Z,Z0,IBC,IBDR,IBT
111 S Z=0
112 F S Z=$O(^DGCR(399,IBIFN,"PRV",Z)) Q:'Z S Z0=$G(^(Z,0)) D
113 . F IBC=5:1:7 I $S(IBFUNC=2:$P(Z0,U,IBC)'="",1:1) S IBDR(399.0222,IBC_","_IBIFN_",",(IBC/100))=$S(IBFUNC=2:"@",1:$$GETID^IBCEP2(IBIFN,2,$P(Z0,U,2),IBC-4,.IBT))
114 I $D(IBDR) D FILE^DIE(,"IBDR")
115 Q
116 ;
117CUMNT ; Add/edit care unit
118 N D,DIE,DIC,DIK,DIR,DA,X,Y,IB,IBINS,IBF,IBCT,IBOK,IBPTYP,IBOLD,IBY,IBINS1,IBPTYP1,DUOUT,DTOUT
119INS F D Q:Y'>0
120 . S DIC="^DIC(36,",DIC(0)="AEMQ" D ^DIC K DIC
121 . I $D(DUOUT)!$D(DTOUT) S Y=-1 Q
122 . I Y'>0 S DIR(0)="EA",DIR("A")="Insurance Co is required - press enter to continue: " D ^DIR K DIR Q
123 . S IBINS=+Y,IBF="A",IBINS1=$P(Y,U,2)
124 I $O(^IBA(355.96,"D",IBINS,""))'="" D
125 . W ! S DIR("A")="(A)dd or (E)dit entries?: ",DIR("B")="Add",DIR(0)="SA^A:Add;E:Edit" D ^DIR W ! K DIR
126 . S IBF=Y
127 Q:$G(IBF)=""!("AE"'[$G(IBF))
128 ;
129 I IBINS>0 D
130 . I IBF="A" D NEW^IBCEP4A(1)
131 . I IBF="E" D CHANGE^IBCEP4A(1)
132 ;
133 Q
134 ;
135DUP(IBDA,IBOLD,IBFUNC) ; Check if the combination of ins co, prov type, care
136 ; type and form already exists in file 355.96
137 ; IBDA = ien of entry in file 355.96
138 ; IBOLD = the 0-node before changes were made - used to reset the fields
139 N DUP,IB0,DR,X,Y,DIK,DIE,DA
140 S IB0=$G(^IBA(355.96,IBDA,0)),DUP=0
141 ;
142 I $O(^IBA(355.96,"AUNIQ",+$P(IB0,U,3),+IB0,+$P(IB0,U,4),+$P(IB0,U,5),+$P(IB0,U,6),0))'=IBDA!($O(^IBA(355.96,"AUNIQ",+$P(IB0,U,3),+IB0,+$P(IB0,U,4),+$P(IB0,U,5),+$P(IB0,U,6),""),-1)'=IBDA) D
143 . S DUP=1
144 . I IBFUNC="E" D
145 .. S DR=";.01///"_$P(IBOLD,U)_";.03///"_$S($P(IBOLD,U,3)'="":"/"_$P(IBOLD,U,3),1:"@")_";.04///"_$S($P(IBOLD,U,4)'="":"/"_$P(IBOLD,U,4),1:"@")
146 .. S DR=DR_";05///"_$S($P(IBOLD,U,5)'="":"/"_$P(IBOLD,U,5),1:"@")_";.06///"_$S($P(IBOLD,U,6)'="":"/"_$P(IBOLD,U,6),1:"@")
147 .. S DA=IBDA,DIE="^IBA(355.96," D ^DIE
148 . I IBFUNC="A" D
149 .. S DA=IBDA,DIK="^IBA(355.96," D ^DIK
150 Q DUP
151 ;
152PROFID(IBIFN,IBSEQ,IBID) ; Return id and type of rendering provider id
153 ; used for insurance co at COB seq IBSEQ for bill ien IBIFN
154 ; RETURN VALUES:
155 ; piece 1:
156 ; 1 = FEDERAL TAX ID
157 ; 2 = INSURANCE CO SPECIFIC ID
158 ; 3 = NETWORK ID
159 ; "" = not a CMS-1500 bill or no id found
160 ; piece 2:
161 ; the id #
162 N IBTYP,IBXDATA,IBZ
163 S:'$G(IBSEQ) IBSEQ=+$$COBN^IBCEF(IBXIEN)
164 S IBTYP=""_U_$G(IBID)
165 G:$$FT^IBCEF(IBIFN)'=2 PROFIDQ
166 I '$D(IBID) D F^IBCEF("N-ALL ATT/RENDERING PROV ID","IBZ",,IBIFN) S IBID=$$NOPUNCT^IBCEF($P(IBZ,U,IBSEQ+1))
167 G:IBID="" PROFIDQ
168 S IBTYP=$S($$NOPUNCT^IBCEF(IBID)=$$NOPUNCT^IBCEF($P($G(^IBE(350.9,1,1)),U,5)):1,$$NETWRK(IBIFN,IBID,IBSEQ):3,1:2)
169 S IBTYP=IBTYP_U_IBID
170 ;
171PROFIDQ Q IBTYP
172 ;
173NETWRK(IBIFN,IBID,IBSEQ) ; Determine if ID number IBID is the same as the
174 ; network id for the insurance co
175 ; IBIFN = bill ien (file 399)
176 ; IBSEQ = COB seq # of bill
177 ; Returns 1 if network ID match is found for bill IBIFN, COB seq IBSEQ
178 N IBINS,IBNET
179 S IBNET=0
180 Q IBNET
181 ; This section needs work *********
182 I '$G(IBSEQ) S IBSEQ=+$$COBN^IBCEF(IBXIEN)
183 S IBINS=+$G(^DGCR(399,IBIFN,"I"_IBSEQ))
184 I $P($G(^IBE(355.97,+$$PPTYP^IBCEP0(IBINS),1)),U,6) D
185 . ; performing provider id type is a network id type
186 . I $$NOPUNCT^IBCEF($G(IBID))=$$NOPUNCT^IBCEF($$GETID^IBCEP2(IBIFN,3,$$PERFPRV^IBCEP2A(IBIFN),IBSEQ)) S IBNET=1
187 Q IBNET
188 ;
189 ;
190 ; Parameter definitions for UNIQ1 and UNIQ2 in IBCEP2
191 ; IBIFN = ien of bill (file 399)
192 ; IBINS = ien of insurance co (file 36) or *ALL* for all insurance
193 ; IBPTYP = the ien of the provider id type in file 355.97
194 ; IBUNIT = the value of the specific care unit to use for a match
195 ; or *N/A* if none needed
196 ; IBCU = the ien of the entry being matched in start file
197 ; IBT = the second and third pieces are set to the entry ien^file #
Note: See TracBrowser for help on using the repository browser.