- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF.m
r613 r623 1 IBCEF ;ALB/TMP - FORMATTER SPECIFIC BILL FUNCTIONS ;22-JAN-96 2 ;;2.0;INTEGRATED BILLING;**52,80,51,137,288,296,361,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;IBIFN = bill ien throughout this routine 6 COB(IBIFN) ; Bill seq 7 N A 8 S A=$P($G(^DGCR(399,IBIFN,0)),U,21) S:A="" A="P" 9 Q A 10 ; 11 COBN(IBIFN,A) ; Return seq # of selected payer 12 ; A = 'PST' or null to get current bill payer seq # 13 I $G(A)="" S A=$$COB(IBIFN) S:"PST"'[A A="P" 14 I 'A S A=$F("PST",A)-1 S:A<1 A=1 15 Q A 16 ; 17 POLICY(IBIFN,IBPC,IBCOBN) ; Return raw data from policy info on bill 18 ; IBPC = pc # of data element in policy (optional) 19 ; if null, 0-node is returned 20 ; IBCOBN = bill designation 1-3 or 'PST' (optional) 21 ; if null, default to current 22 N IBI 23 I "PST"[$G(IBCOBN) S IBCOBN=$$COBN(IBIFN,$G(IBCOBN)) 24 S IBI=$G(^DGCR(399,IBIFN,"I"_IBCOBN)) 25 I $G(IBPC) S IBI=$P(IBI,U,IBPC) 26 POLICYQ Q IBI 27 ; 28 INSADDR(IBIFN,IBCOB) ; Return insured's address in 7 pieces: 29 ; ALL STREET ADDRESSES^CITY^STATE ABBREVIATION^ZIP^STREET ADDRESS 1^ 30 ; STREET ADDRESS 2^STREET ADDRESS 3 31 ; IBIFN = bill ien 32 ; IBCOB = bill designation (P)rimary, (S)econdary, (T)ertiary 33 ; or 1-2-3. If not defined or null, return current 34 ; If insured is patient or spouse, take from patient file top level 35 ; fields, then if top-level street addresses are blank and policy 36 ; level fields are not, use policy level 37 ; If insured is other than patient/spouse, use policy level fields only 38 N A,B,IBADDR,IBI,DFN,VAPA,VATEST 39 S:$G(IBCOB)="" IBCOB="" 40 I 'IBCOB S IBCOB=$$COBN(IBIFN,$G(IBCOB)) 41 S IBI=+$$POLICY(IBIFN,16,IBCOB) ; pt relationship to insured 42 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) 43 I $S('IBI:1,1:"12"'[IBI) S IBADDR="" G INSADDQ 44 ; insured's address (patient/spouse) same as patient's 45 S VATEST("ADD",9)=+$G(^DGCR(399,IBIFN,"U")),VATEST("ADD",10)=+$P($G(^("U")),U,2) 46 D ADD^VADPT 47 S IBADDR=VAPA(1)_" "_VAPA(2)_" "_VAPA(3)_U_VAPA(4)_U_$P($G(^DIC(5,+VAPA(5),0)),U,2)_U_VAPA(6)_U_VAPA(1)_U_VAPA(2)_U_VAPA(3) 48 INSADDQ S A=$P($G(^DGCR(399,IBIFN,"M")),U,(11+IBCOB)) 49 S A=$G(^DPT(DFN,.312,+A,3)) 50 I $TR($P(IBADDR,U)," ")="" D PI3 51 I IBI=2,$$NOPUNCT($P(A,U,6,10),1)'="" D PI3 52 Q IBADDR 53 ; 54 PI3 ; build IBADDR string from patient insurance 3 node data 55 S $P(IBADDR,U,1)=$P(A,U,6)_" "_$P(A,U,7) 56 S $P(IBADDR,U,5,6)=$P(A,U,6,7) 57 F B=2,4 S $P(IBADDR,U,B)=$P(A,U,B+6) 58 S $P(IBADDR,U,3)=$P($G(^DIC(5,+$P(A,U,9),0)),U,2) 59 S $P(IBADDR,U,7)="" ; no street address 3 in file 2.312 60 Q 61 ; 62 PTADDR(IBIFN,ELE) ;Return part of patient's permanent address 63 ;IBIFN = bill ien 64 ;ELE = subscript in ^UTILITY("VAPA", array for element needed 65 ; 66 I '$D(^UTILITY("VAPA",$J)) D ; once per pt 67 .N VAHOW,DFN,VAPA 68 .S VAHOW=2,DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2),VAPA("P")="" 69 .D ADD^VADPT 70 Q $P($G(^UTILITY("VAPA",$J,ELE)),U) 71 ; 72 PTDEM(IBIFN,ELE,PC) ;Return part of patient's demographics 73 ;IBIFN = bill ien 74 ;ELE = subscript in ^UTILITY("VADM" array for demographic element needed 75 ;PC = pc of string at subscript ELE to be returned 76 ; 77 I '$G(PC) S PC=1 78 I '$D(^UTILITY("VADM",$J)) D ; once per pt 79 .N VAHOW,DFN,VADM 80 .S VAHOW=2,DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) 81 .D DEM^VADPT 82 Q $P($G(^UTILITY("VADM",$J,ELE)),U,PC) 83 ; 84 PTEMPL(IBIFN,ELE,WHOSE,VAOA) ;Return part of pt's or spouse's employer info 85 ;ELE = subscript in VAOA array for employer element needed 86 ;WHOSE = 6 if spouse's info needed 5 if pt info needed (DEFAULT) 87 ; 88 N DFN 89 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2),VAOA("A")=$S($G(WHOSE):WHOSE,1:5) 90 D OAD^VADPT 91 Q $P($G(VAOA(ELE)),U) 92 ; 93 INSDEM(IBIFN,IBCOB) ; Return insured's demographics in 6 pieces: 94 ; DATE OF BIRTH^SEX^PHONE^BRANCH pointer^RANK^SSN(no dashes) 95 ; IBIFN = bill ien 96 ; IBCOB = bill designation (P)rimary (default), (S)econdary, (T)ertiary 97 ; or 1,2,3 ... if not defined or null, return current 98 ; If insured is patient/spouse, take from patient file top level 99 ; fields, then if top-level are blank and policy level aren't, 100 ; use policy level 101 ; If insured other than patient/spouse, use policy level fields only 102 N A,B,IBDEM,IBI,DFN,VADM 103 S:$G(IBCOB)="" IBCOB="" 104 S:'IBCOB IBCOB=$$COBN(IBIFN,IBCOB) 105 S IBI=$$WHOSINS(IBIFN,IBCOB) 106 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) 107 I $S('IBI:1,1:"12"'[IBI) S IBDEM="" G INSDEM1 108 ; If it gets here, assume insured is patient/spouse 109 S A=$$PTDEM(IBIFN,0),A=$$PTADDR(IBIFN,0) 110 F A=2,3,5 S VADM(A)=$P($G(^UTILITY("VADM",$J,A)),U) 111 S VAPA(8)=$P($G(^UTILITY("VAPA",$J,8)),U) 112 I VADM(5)="",'VADM(3),VAPA(8)="" S IBDEM="" G INSDEM1 113 S $P(IBDEM,U,3)=VAPA(8),$P(IBDEM,U,6)=VADM(2) 114 I IBI=1,VADM(3) S $P(IBDEM,U)=VADM(3) ;Patient's own policy only 115 INSDEM1 S A=$P($G(^DGCR(399,IBIFN,"M")),U,(11+IBCOB)) 116 S A=$G(^DPT(DFN,.312,+A,3)) 117 S:"MF"'[$G(VADM(5)) VADM(5)="" 118 S $P(IBDEM,U,2)=$S(IBI=1:VADM(5),1:$P(A,U,12)) 119 S $P(IBDEM,U,4,5)=$P(A,U,2)_U_$P(A,U,3) 120 S:'$P(IBDEM,U) $P(IBDEM,U)=$P(A,U) 121 S:$P(IBDEM,U,3)="" $P(IBDEM,U,3)=$P(A,U,11) 122 S:$P(IBDEM,U,6)="" $P(IBDEM,U,6)=$P(A,U,5) 123 Q IBDEM 124 ; 125 INSEMPL(IBIFN,IBCOB) ; Return insured's employer data in 5 pieces: 126 ; EMPLOYER NAME^EMPLOYER CITY^EMPLOYER STATE ABBREVIATION^STATE IEN^STREET 1 127 ; IBCOB = bill designation (P)rimary-default, (S)econdary, (T)ertiary 128 ; or 123 - if not defined or null, return current 129 N A,IBEMPL,IBI,DFN,VAOA 130 S IBI=$$WHOSINS(IBIFN,$G(IBCOB)) 131 I $S('IBI:1,1:"12"'[IBI) S IBEMPL="^^" G INSEMPQ 132 ; insured = pt/spouse 133 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) 134 S A=$$PTEMPL(IBIFN,0,IBI+4,.VAOA) 135 S IBEMPL=VAOA(9)_U_VAOA(4)_U_$P($G(^DIC(5,+VAOA(5),0)),U,2)_U_+VAOA(5)_U_VAOA(1) 136 INSEMPQ Q IBEMPL 137 ; 138 WHOSINS(IBIFN,IBCOB) ; Determine who is insured for bill IBIFN and 139 ; seq of coverage COB (123 or PST) or if not defined or null, current 140 N Z,Z0,VAEL,DFN 141 S Z=+$$POLICY(IBIFN,16,$G(IBCOB)) 142 I 'Z D 143 .S Z0=$$POLICY(IBIFN,6,$G(IBCOB)),DFN=$P($G(^DGCR(399,IBIFN,0)),U,2) 144 .I Z0="v" D ELIG^VADPT I VAEL(4) S Z=1 Q ;vet is pt 145 .I Z0="s" D ELIG^VADPT I VAEL(4) S Z=2 Q ;vet is pt, so vets spouse is pt's spouse 146 .S Z=9 ; relationship of insured to pt unknown 147 Q Z 148 ; 149 EMPSTAT(IBIFN,WHOSE) ;Return employment status 150 ; IBIFN = bill ien 151 ; WHOSE = v for vet, s for spouse status 152 N STAT,DFN,VAPD 153 S STAT="",DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) 154 I WHOSE="v" D OPD^VADPT S STAT=$P(VAPD(7),U) 155 I WHOSE="s" S STAT=$P($G(^DPT(DFN,.25)),U,15) 156 I STAT="" S STAT=9 157 Q STAT 158 ; 159 INPAT(IBIFN,OUT) ; Determine if bill is inpatient 160 ; OUT = optional - if 1, return output value based on 161 ; inpatient/outpatient from UB-04 type of bill field 162 ; Return 1 if inpatient, 0 if not inpatient or can't be determined 163 N INPT,CODE,CODE0,IB0 164 S IB0=$G(^DGCR(399,IBIFN,0)) 165 S OUT=+$G(OUT),CODE=+$P(IB0,U,5) 166 I 'OUT S INPT=CODE 167 I OUT D 168 . S CODE0=$P($G(^DGCR(399.1,+$P(IB0,U,25),0)),U,2) 169 . I CODE0=8,$P(IB0,U,24)=1 S INPT=$P(IB0,U,5) Q ; 18X 170 . I CODE0=9,$P(IB0,U,24)=8 S INPT=$P(IB0,U,5) Q ; 89X 171 . I CODE0=1,$P(IB0,U,24)=8 S INPT=0 Q ; 81X 172 . I CODE0=1,$P(IB0,U,24)=7 S INPT=0 Q ; 71X 173 . I CODE0=2,$P(IB0,U,24)=7 S INPT=0 Q ; 72X 174 . S INPT=CODE0 175 Q $S(INPT:INPT'>2,1:0) 176 ; 177 INSPRF(IBIFN) ; Function to determine if bill is prof or inst 178 ; Return 1 if institutional (UB-04) claim, 0 if professional (CMS-1500) claim 179 N A 180 S A=$G(^DGCR(399,IBIFN,0)) 181 I $P(A,U,27)="" S $P(A,U,27)=$S($P(A,U,19)=3:1,1:0) 182 Q $S($P(A,U,27)=1:1,1:0) 183 ; 184 F(FLD,IBXRET,IBXERR1,IBIEN) ;Execute extract for data element FLD and bill IBIEN 185 ; If IBXDATA array to be returned as data value(s) of fld 186 ; D F^IBCEF("FLD NAME","IBXDATA","IBXERR") or D F^IBCEF("FLD NAME") 187 ; Variable ref-ed by IBXERR1 will contain error message if an error 188 ; @IBXRET always defined on return. It will be null if error 189 I $G(IBIEN) N IBXIEN S IBXIEN=IBIEN 190 I $G(IBXERR1)="" S IBXERR1="IBXERR" 191 N IBXHOLD 192 S IBXHOLD="" 193 I $G(IBXRET)=""!($G(IBXRET)="IBXDATA") S IBXHOLD="IBXDATA",IBXRET="IBXRET" 194 S @IBXERR1="" 195 ; 196 N FLDN,OFLD,STOP,Z,IBXERR2,IBXRETX 197 ; 198 I '$G(IBXIEN) S @IBXERR1="Invalid entry #" G FQ 199 I '$D(^IBA(364.5,"B",FLD)) S OFLD=FLD,STOP=0 D I FLD="" S @IBXERR1=OFLD_" Field not found!!" G FQ 200 .F S FLD=$O(^IBA(364.5,"B",FLD)) D Q:STOP 201 ..I $E(FLD,1,$L(OFLD))'=OFLD S FLD="" 202 ..S STOP=1 203 ; 204 S Z=0 205 F S Z=$O(^IBA(364.5,"B",FLD,Z)) Q:'Z I $P($G(^IBA(364.5,Z,0)),U,5)=399 Q 206 I 'Z S @IBXERR1=FLD_" Field not found!!" G FQ 207 ; 208 S FLDN(1)=Z D EXTONE^IBCEFG0(IBXIEN,.FLDN,""_IBXRET_"",.IBXERR2) 209 ; 210 I $G(IBXERR2)'="" S @IBXERR1=IBXERR2 211 FQ S IBXARRY=$S(IBXHOLD="IBXDATA":"IBXDATA",1:""_IBXRET_"") 212 I @IBXERR1'="" K @IBXARRY S @IBXARRY="" Q 213 ; 214 I IBXHOLD="IBXDATA" S IBXRET="IBXRET" 215 M IBXRETX=@IBXRET K @IBXARRY M @IBXARRY=IBXRETX(1) 216 S:'($D(@IBXARRY)#2) @IBXARRY="" 217 Q 218 ; 219 SERVDT(IBIFN,LENGTH,FORMAT) ; Return default service date for 220 ; outpatient/UB-04 lines or X12-837 institutional lines 221 ; LENGTH = null/8 for 8 digit date, 6 for 6 digit date 222 ; FORMAT = 1 = X12 format (YYYYMMDD), 2 = FM internal (NNNNNNN), 223 ; 0 = external (MMDDYY or MMDDYYYY) 224 N IBZ 225 G:$$INPAT^IBCEF(IBIFN,1)!($$FT^IBCEF(IBIFN)'=3) SERVDTQ ;Inpatient claim or billed on a CMS-1500 226 S LENGTH=$G(LENGTH),FORMAT=$G(FORMAT) 227 D F("N-STATEMENT COVERS FROM DATE","IBZ",,IBIFN) 228 I '$G(IBZ)!(FORMAT=2) G SERVDTQ 229 ; 230 I FORMAT=1 S IBZ=$$DT^IBCEFG1(IBZ,"",$S(LENGTH'=6:"D8",1:"D6")) G SERVDTQ 231 S IBZ=$$DATE^IBCF2(IBZ,$S(LENGTH=6:0,1:1),1) 232 ; 233 SERVDTQ Q $G(IBZ) 234 ; 235 NOPUNCT(X,SPACE,EXC) ; Strip punctuation from data in X 236 ; SPACE = flag if 1 strip SPACES 237 ; EXC = list of punctuation not to strip 238 ; 239 N PUNCT,Z 240 S PUNCT=".,-+(){}[]\/><:;?|=_*&%$#@!~`^'""" 241 I $G(SPACE) S PUNCT=PUNCT_" " 242 I $G(EXC)'="" F Z=1:1:$L(EXC) S PUNCT=$TR(PUNCT,$E(EXC,Z)) 243 S X=$TR(X,PUNCT) 244 Q X 245 ; 246 FT(IBIFN) ; Internal code for bill form type 247 Q +$P($G(^DGCR(399,IBIFN,0)),U,19) 248 ; 249 COBCT(IBIFN) ; # of payers on claim 250 N CT,Z 251 S CT=0 F Z="I1","I2","I3" Q:'$D(^DGCR(399,IBIFN,Z)) S CT=CT+1 252 Q CT 253 ; 1 IBCEF ;ALB/TMP - FORMATTER SPECIFIC BILL FUNCTIONS ;22-JAN-96 2 ;;2.0;INTEGRATED BILLING;**52,80,51,137,288,296,361**;21-MAR-94;Build 9 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;IBIFN = bill ien throughout this routine 6 COB(IBIFN) ; Bill seq 7 N A 8 S A=$P($G(^DGCR(399,IBIFN,0)),U,21) S:A="" A="P" 9 Q A 10 ; 11 COBN(IBIFN,A) ; Return seq # of selected payer 12 ; A = 'PST' or null to get current bill payer seq # 13 I $G(A)="" S A=$$COB(IBIFN) S:"PST"'[A A="P" 14 I 'A S A=$F("PST",A)-1 S:A<1 A=1 15 Q A 16 ; 17 POLICY(IBIFN,IBPC,IBCOBN) ; Return raw data from policy info on bill 18 ; IBPC = pc # of data element in policy (optional) 19 ; if null, 0-node is returned 20 ; IBCOBN = bill designation 1-3 or 'PST' (optional) 21 ; if null, default to current 22 N IBI 23 I "PST"[$G(IBCOBN) S IBCOBN=$$COBN(IBIFN,$G(IBCOBN)) 24 S IBI=$G(^DGCR(399,IBIFN,"I"_IBCOBN)) 25 I $G(IBPC) S IBI=$P(IBI,U,IBPC) 26 POLICYQ Q IBI 27 ; 28 INSADDR(IBIFN,IBCOB) ; Return insured's address in 7 pieces: 29 ; ALL STREET ADDRESSES^CITY^STATE ABBREVIATION^ZIP^STREET ADDRESS 1^ 30 ; STREET ADDRESS 2^STREET ADDRESS 3 31 ; IBIFN = bill ien 32 ; IBCOB = bill designation (P)rimary, (S)econdary, (T)ertiary 33 ; or 1-2-3. If not defined or null, return current 34 ; If insured is patient or spouse, take from patient file top level 35 ; fields, then if top-level street addresses are blank and policy 36 ; level fields are not, use policy level 37 ; If insured is other than patient/spouse, use policy level fields only 38 N A,B,IBADDR,IBI,DFN,VAPA,VATEST 39 S:$G(IBCOB)="" IBCOB="" 40 I 'IBCOB S IBCOB=$$COBN(IBIFN,$G(IBCOB)) 41 S IBI=+$$POLICY(IBIFN,16,IBCOB) 42 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) 43 I $S('IBI:1,1:"12"'[IBI) S IBADDR="" G INSADDQ 44 ; insured's address (patient/spouse) same as patient's 45 S VATEST("ADD",9)=+$G(^DGCR(399,IBIFN,"U")),VATEST("ADD",10)=+$P($G(^("U")),U,2) 46 D ADD^VADPT 47 S IBADDR=VAPA(1)_" "_VAPA(2)_" "_VAPA(3)_U_VAPA(4)_U_$P($G(^DIC(5,+VAPA(5),0)),U,2)_U_VAPA(6)_U_VAPA(1)_U_VAPA(2)_U_VAPA(3) 48 INSADDQ S A=$P($G(^DGCR(399,IBIFN,"M")),U,(11+IBCOB)) 49 S A=$G(^DPT(DFN,.312,+A,3)) 50 I $TR($P(IBADDR,U)," ")="" D 51 .S $P(IBADDR,U)=$P(A,U,6)_" "_$P(A,U,7),$P(IBADDR,U,5,6)=$P(A,U,6,7) 52 .F B=2,4 S $P(IBADDR,U,B)=$P(A,U,B+6) 53 .S $P(IBADDR,U,3)=$P($G(^DIC(5,+$P(A,U,9),0)),U,2) 54 Q IBADDR 55 ; 56 PTADDR(IBIFN,ELE) ;Return part of patient's permanent address 57 ;IBIFN = bill ien 58 ;ELE = subscript in ^UTILITY("VAPA", array for element needed 59 ; 60 I '$D(^UTILITY("VAPA",$J)) D ; once per pt 61 .N VAHOW,DFN,VAPA 62 .S VAHOW=2,DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2),VAPA("P")="" 63 .D ADD^VADPT 64 Q $P($G(^UTILITY("VAPA",$J,ELE)),U) 65 ; 66 PTDEM(IBIFN,ELE,PC) ;Return part of patient's demographics 67 ;IBIFN = bill ien 68 ;ELE = subscript in ^UTILITY("VADM" array for demographic element needed 69 ;PC = pc of string at subscript ELE to be returned 70 ; 71 I '$G(PC) S PC=1 72 I '$D(^UTILITY("VADM",$J)) D ; once per pt 73 .N VAHOW,DFN,VADM 74 .S VAHOW=2,DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) 75 .D DEM^VADPT 76 Q $P($G(^UTILITY("VADM",$J,ELE)),U,PC) 77 ; 78 PTEMPL(IBIFN,ELE,WHOSE,VAOA) ;Return part of pt's or spouse's employer info 79 ;ELE = subscript in VAOA array for employer element needed 80 ;WHOSE = 6 if spouse's info needed 5 if pt info needed (DEFAULT) 81 ; 82 N DFN 83 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2),VAOA("A")=$S($G(WHOSE):WHOSE,1:5) 84 D OAD^VADPT 85 Q $P($G(VAOA(ELE)),U) 86 ; 87 INSDEM(IBIFN,IBCOB) ; Return insured's demographics in 6 pieces: 88 ; DATE OF BIRTH^SEX^PHONE^BRANCH pointer^RANK^SSN(no dashes) 89 ; IBIFN = bill ien 90 ; IBCOB = bill designation (P)rimary (default), (S)econdary, (T)ertiary 91 ; or 1,2,3 ... if not defined or null, return current 92 ; If insured is patient/spouse, take from patient file top level 93 ; fields, then if top-level are blank and policy level aren't, 94 ; use policy level 95 ; If insured other than patient/spouse, use policy level fields only 96 N A,B,IBDEM,IBI,DFN,VADM 97 S:$G(IBCOB)="" IBCOB="" 98 S:'IBCOB IBCOB=$$COBN(IBIFN,IBCOB) 99 S IBI=$$WHOSINS(IBIFN,IBCOB) 100 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) 101 I $S('IBI:1,1:"12"'[IBI) S IBDEM="" G INSDEM1 102 ; If it gets here, assume insured is patient/spouse 103 S A=$$PTDEM(IBIFN,0),A=$$PTADDR(IBIFN,0) 104 F A=2,3,5 S VADM(A)=$P($G(^UTILITY("VADM",$J,A)),U) 105 S VAPA(8)=$P($G(^UTILITY("VAPA",$J,8)),U) 106 I VADM(5)="",'VADM(3),VAPA(8)="" S IBDEM="" G INSDEM1 107 S $P(IBDEM,U,3)=VAPA(8),$P(IBDEM,U,6)=VADM(2) 108 I IBI=1,VADM(3) S $P(IBDEM,U)=VADM(3) ;Patient's own policy only 109 INSDEM1 S A=$P($G(^DGCR(399,IBIFN,"M")),U,(11+IBCOB)) 110 S A=$G(^DPT(DFN,.312,+A,3)) 111 S:"MF"'[$G(VADM(5)) VADM(5)="" 112 S $P(IBDEM,U,2)=$S(IBI=1:VADM(5),1:$P(A,U,12)) 113 S $P(IBDEM,U,4,5)=$P(A,U,2)_U_$P(A,U,3) 114 S:'$P(IBDEM,U) $P(IBDEM,U)=$P(A,U) 115 S:$P(IBDEM,U,3)="" $P(IBDEM,U,3)=$P(A,U,11) 116 S:$P(IBDEM,U,6)="" $P(IBDEM,U,6)=$P(A,U,5) 117 Q IBDEM 118 ; 119 INSEMPL(IBIFN,IBCOB) ; Return insured's employer data in 5 pieces: 120 ; EMPLOYER NAME^EMPLOYER CITY^EMPLOYER STATE ABBREVIATION^STATE IEN^STREET 1 121 ; IBCOB = bill designation (P)rimary-default, (S)econdary, (T)ertiary 122 ; or 123 - if not defined or null, return current 123 N A,IBEMPL,IBI,DFN,VAOA 124 S IBI=$$WHOSINS(IBIFN,$G(IBCOB)) 125 I $S('IBI:1,1:"12"'[IBI) S IBEMPL="^^" G INSEMPQ 126 ; insured = pt/spouse 127 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) 128 S A=$$PTEMPL(IBIFN,0,IBI+4,.VAOA) 129 S IBEMPL=VAOA(9)_U_VAOA(4)_U_$P($G(^DIC(5,+VAOA(5),0)),U,2)_U_+VAOA(5)_U_VAOA(1) 130 INSEMPQ Q IBEMPL 131 ; 132 WHOSINS(IBIFN,IBCOB) ; Determine who is insured for bill IBIFN and 133 ; seq of coverage COB (123 or PST) or if not defined or null, current 134 N Z,Z0,VAEL,DFN 135 S Z=+$$POLICY(IBIFN,16,$G(IBCOB)) 136 I 'Z D 137 .S Z0=$$POLICY(IBIFN,6,$G(IBCOB)),DFN=$P($G(^DGCR(399,IBIFN,0)),U,2) 138 .I Z0="v" D ELIG^VADPT I VAEL(4) S Z=1 Q ;vet is pt 139 .I Z0="s" D ELIG^VADPT I VAEL(4) S Z=2 Q ;vet is pt, so vets spouse is pt's spouse 140 .S Z=9 ; relationship of insured to pt unknown 141 Q Z 142 ; 143 EMPSTAT(IBIFN,WHOSE) ;Return employment status 144 ; IBIFN = bill ien 145 ; WHOSE = v for vet, s for spouse status 146 N STAT,DFN,VAPD 147 S STAT="",DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) 148 I WHOSE="v" D OPD^VADPT S STAT=$P(VAPD(7),U) 149 I WHOSE="s" S STAT=$P($G(^DPT(DFN,.25)),U,15) 150 I STAT="" S STAT=9 151 Q STAT 152 ; 153 INPAT(IBIFN,OUT) ; Determine if bill is inpatient 154 ; OUT = optional - if 1, return output value based on 155 ; inpatient/outpatient from UB-04 type of bill field 156 ; Return 1 if inpatient, 0 if not inpatient or can't be determined 157 N INPT,CODE,CODE0,IB0 158 S IB0=$G(^DGCR(399,IBIFN,0)) 159 S OUT=+$G(OUT),CODE=+$P(IB0,U,5) 160 I 'OUT S INPT=CODE 161 I OUT D 162 . S CODE0=$P($G(^DGCR(399.1,+$P(IB0,U,25),0)),U,2) 163 . I CODE0=8,$P(IB0,U,24)=1 S INPT=$P(IB0,U,5) Q ; 18X 164 . I CODE0=9,$P(IB0,U,24)=8 S INPT=$P(IB0,U,5) Q ; 89X 165 . I CODE0=1,$P(IB0,U,24)=8 S INPT=0 Q ; 81X 166 . I CODE0=1,$P(IB0,U,24)=7 S INPT=0 Q ; 71X 167 . I CODE0=2,$P(IB0,U,24)=7 S INPT=0 Q ; 72X 168 . S INPT=CODE0 169 Q $S(INPT:INPT'>2,1:0) 170 ; 171 INSPRF(IBIFN) ; Function to determine if bill is prof or inst 172 ; Return 1 if institutional (UB-04) claim, 0 if professional (CMS-1500) claim 173 N A 174 S A=$G(^DGCR(399,IBIFN,0)) 175 I $P(A,U,27)="" S $P(A,U,27)=$S($P(A,U,19)=3:1,1:0) 176 Q $S($P(A,U,27)=1:1,1:0) 177 ; 178 F(FLD,IBXRET,IBXERR1,IBIEN) ;Execute extract for data element FLD and bill IBIEN 179 ; If IBXDATA array to be returned as data value(s) of fld 180 ; D F^IBCEF("FLD NAME","IBXDATA","IBXERR") or D F^IBCEF("FLD NAME") 181 ; Variable ref-ed by IBXERR1 will contain error message if an error 182 ; @IBXRET always defined on return. It will be null if error 183 I $G(IBIEN) N IBXIEN S IBXIEN=IBIEN 184 I $G(IBXERR1)="" S IBXERR1="IBXERR" 185 N IBXHOLD 186 S IBXHOLD="" 187 I $G(IBXRET)=""!($G(IBXRET)="IBXDATA") S IBXHOLD="IBXDATA",IBXRET="IBXRET" 188 S @IBXERR1="" 189 ; 190 N FLDN,OFLD,STOP,Z,IBXERR2,IBXRETX 191 ; 192 I '$G(IBXIEN) S @IBXERR1="Invalid entry #" G FQ 193 I '$D(^IBA(364.5,"B",FLD)) S OFLD=FLD,STOP=0 D I FLD="" S @IBXERR1=OFLD_" Field not found!!" G FQ 194 .F S FLD=$O(^IBA(364.5,"B",FLD)) D Q:STOP 195 ..I $E(FLD,1,$L(OFLD))'=OFLD S FLD="" 196 ..S STOP=1 197 ; 198 S Z=0 199 F S Z=$O(^IBA(364.5,"B",FLD,Z)) Q:'Z I $P($G(^IBA(364.5,Z,0)),U,5)=399 Q 200 I 'Z S @IBXERR1=FLD_" Field not found!!" G FQ 201 ; 202 S FLDN(1)=Z D EXTONE^IBCEFG0(IBXIEN,.FLDN,""_IBXRET_"",.IBXERR2) 203 ; 204 I $G(IBXERR2)'="" S @IBXERR1=IBXERR2 205 FQ S IBXARRY=$S(IBXHOLD="IBXDATA":"IBXDATA",1:""_IBXRET_"") 206 I @IBXERR1'="" K @IBXARRY S @IBXARRY="" Q 207 ; 208 I IBXHOLD="IBXDATA" S IBXRET="IBXRET" 209 M IBXRETX=@IBXRET K @IBXARRY M @IBXARRY=IBXRETX(1) 210 S:'($D(@IBXARRY)#2) @IBXARRY="" 211 Q 212 ; 213 SERVDT(IBIFN,LENGTH,FORMAT) ; Return default service date for 214 ; outpatient/UB-04 lines or X12-837 institutional lines 215 ; LENGTH = null/8 for 8 digit date, 6 for 6 digit date 216 ; FORMAT = 1 = X12 format (YYYYMMDD), 2 = FM internal (NNNNNNN), 217 ; 0 = external (MMDDYY or MMDDYYYY) 218 N IBZ 219 G:$$INPAT^IBCEF(IBIFN,1)!($$FT^IBCEF(IBIFN)'=3) SERVDTQ ;Inpatient claim or billed on a CMS-1500 220 S LENGTH=$G(LENGTH),FORMAT=$G(FORMAT) 221 D F("N-STATEMENT COVERS FROM DATE","IBZ",,IBIFN) 222 I '$G(IBZ)!(FORMAT=2) G SERVDTQ 223 ; 224 I FORMAT=1 S IBZ=$$DT^IBCEFG1(IBZ,"",$S(LENGTH'=6:"D8",1:"D6")) G SERVDTQ 225 S IBZ=$$DATE^IBCF2(IBZ,$S(LENGTH=6:0,1:1),1) 226 ; 227 SERVDTQ Q $G(IBZ) 228 ; 229 NOPUNCT(X,SPACE,EXC) ; Strip punctuation from data in X 230 ; SPACE = flag if 1 strip SPACES 231 ; EXC = list of punctuation not to strip 232 ; 233 N PUNCT,Z 234 S PUNCT=".,-+(){}[]\/><:;?|=_*&%$#@!~`^'""" 235 I $G(SPACE) S PUNCT=PUNCT_" " 236 I $G(EXC)'="" F Z=1:1:$L(EXC) S PUNCT=$TR(PUNCT,$E(EXC,Z)) 237 S X=$TR(X,PUNCT) 238 Q X 239 ; 240 FT(IBIFN) ; Internal code for bill form type 241 Q +$P($G(^DGCR(399,IBIFN,0)),U,19) 242 ; 243 COBCT(IBIFN) ; # of payers on claim 244 N CT,Z 245 S CT=0 F Z="I1","I2","I3" Q:'$D(^DGCR(399,IBIFN,Z)) S CT=CT+1 246 Q CT 247 ;
Note:
See TracChangeset
for help on using the changeset viewer.
