- 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/IBCNS1.m
r613 r623 1 IBCNS1 ;ALB/AAS - INSURANCE MANAGEMENT SUPPORTED FUNCTIONS ;22-JULY-91 2 ;;2.0;INTEGRATED BILLING;**28,60,52,85,107,51,137,240,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 INSURED(DFN,IBINDT) ; -- Is patient insured 6 ; --Input DFN = patient 7 ; IBINDT = (optional) date insured (default = today) 8 ; -- Output = 0 - not insured 9 ; = 1 - insured 10 ; 11 N J,X,IBINS S IBINS=0,J=0 12 I '$G(DFN) G INSQ 13 I '$G(IBINDT) S IBINDT=DT 14 F S J=$O(^DPT(DFN,.312,J)) Q:'J S X=$G(^(J,0)) S IBINS=$$CHK(X,IBINDT) Q:IBINS 15 INSQ Q IBINS 16 ; 17 PRE(DFN,IBINDT) ; -- is pre-certification required for patient 18 N X,Y,J,IBPRE 19 S IBPRE=0,J=0 20 S:'$G(IBINDT) IBINDT=DT 21 F S J=$O(^DPT(DFN,.312,J)) Q:'J S X=$G(^(J,0)) I $$CHK(X,IBINDT),$P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",6) S IBPRE=1 Q 22 PREQ Q IBPRE 23 ; 24 UR(DFN,IBINDT) ; -- is ur required for patient 25 N X,Y,J,IBPRE 26 S IBUR=0,J=0 27 S:'$G(IBINDT) IBINDT=DT 28 F S J=$O(^DPT(DFN,.312,J)) Q:'J S X=$G(^(J,0)) I $$CHK(X,IBINDT),$P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",5) S IBUR=1 Q 29 URQ Q IBUR 30 ; 31 CHK(X,Z,Y) ; -- check one entry for active 32 ; -- Input X = Zeroth node of entry in insurance multiple (2.312) 33 ; Z = date to check 34 ; Y = 2 if want will not reimburse 35 ; = 3 if want will not reimburse AND indemnity plans 36 ; = 4 if want will not reimburse, but only if it's 37 ; MEDICARE 38 ; -- Output 1 = Insurance Active 39 ; 0 = Inactive 40 ; 41 N Z1,X1 42 S Z1=0,Y=$G(Y) 43 I Y'=3,$$INDEM(X) G CHKQ ; is an indemnity policy or company 44 S X1=$G(^DIC(36,+X,0)) G:X1="" CHKQ ;insurance company entry doesn't exist 45 I $P(X,"^",8) G:Z<$P(X,"^",8) CHKQ ;effective date later than care 46 I $P(X,"^",4) G:Z>$P(X,"^",4) CHKQ ;care after expiration date 47 I $P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",11) G CHKQ ;plan is inactive 48 G:$P(X1,"^",5) CHKQ ;insurance company inactive 49 I Y<2 G:$P(X1,"^",2)="N" CHKQ ;insurance company will not reimburse 50 I Y=4,$P(X1,"^",2)="N",'$$MCRWNR^IBEFUNC(+X) G CHKQ ;only MEDICARE WNR 51 S Z1=1 52 CHKQ Q Z1 53 ; 54 ACTIVE(IBCIFN) ; -- is this company active for this patient for this date 55 ; -- called from input transform and x-refs for fields 101,102,103 56 ; -- input 57 N ACTIVE,DFN,IBINDT 58 S DFN=$P(^DGCR(399,DA,0),"^",2),IBINDT=$S(+$G(^DGCR(399,DA,"U")):+$G(^("U")),1:DT) 59 ; 60 ACTIVEQ Q ACTIVE 61 ; 62 DD ; - called from input transform and x-refs for field 101,102,103 63 ; - input requires da=internal entry number in 399 64 ; - outputs IBdd(ins co.) array 65 N DFN S DFN=$P(^DGCR(399,DA,0),"^",2),IBINDT=$S(+$G(^DGCR(399,DA,"U")):+$G(^("U")),1:DT) 66 D ALLACT 67 DDQ K IBINDT Q 68 ; 69 ; 70 ALLACT ; -- return active insurance zeroth nodes in ibdd(ins co,entry in mult) 71 N X,X1 72 S (X1,IBDD)=0 73 F S X1=$O(^DPT(DFN,.312,X1)) Q:'X1 S X=$G(^(X,0)) I $$CHK(X,IBINDT) S IBDD(+X,X1)=X 74 ; 75 ALLACTQ Q 76 ; 77 HDR W !?4,"Insurance Co.",?22,"Policy #",?40,"Group",?52,"Holder",?60,"Effective",?70,"Expires" S X="",$P(X,"=",IOM-4)="" W !?4,X 78 Q 79 ; 80 ; 81 D1 N X Q:'$D(IBINS) 82 W !?4,$S($D(^DIC(36,+IBINS,0)):$E($P(^(0),"^",1),1,16),1:"UNKNOWN") 83 W ?22,$E($P(IBINS,"^",2),1,16) 84 W ?40,$E($$GRP^IBCNS($P(IBINS,"^",18)),1,10) 85 S X=$P(IBINS,"^",6) W ?52,$S(X="v":"SELF",X="s":"SPOUSE",1:"OTHER") 86 W ?60,$$DAT1^IBOUTL($P(IBINS,"^",8)),?70,$$DAT1^IBOUTL($P(IBINS,"^",4)) 87 Q 88 ; 89 ALL(DFN,VAR,ACT,ADT,SOP) ; -- find all insurance data on a patient 90 ; 91 ; -- input DFN = patient 92 ; VAR = variable to output in format of abc 93 ; or abc(dfn) 94 ; or ^tmp($j,"Insurance") 95 ; ACT = 1 if only active ins. desired 96 ; = 2 if active and will not reimburse desired 97 ; = 3 if active, will not reimburse, and indemnity are 98 ; all desired (for the $$INSTYP function below) 99 ; = 4 if only active and MEDICARE WNR only desired 100 ; ADT = if ACT=1 or 4, then ADT is the internal date to check 101 ; active for, default = dt 102 ; SOP = if SOP=1, then sort policies in COB order 103 ; 104 ; -- output var(0) =: number of entries insurance multiple 105 ; var(x,0) =: ^dpt(dfn,.312,x,0) 106 ; var(x,1) =: ^dpt(dfn,.312,x,1) 107 ; var(x,2) =: ^dpt(dfn,.312,x,2) 108 ; var(x,3) =: ^dpt(dfn,.312,x,3) 109 ; var(x,4) =: ^dpt(dfn,.312,x,4) 110 ; var(x,5) =: ^dpt(dfn,.312,x,5) 111 ; var(x,355.3) =: ^iba(355.3,$p(var(x,0),"^",18),0) 112 ; var("S",COB sequence,x) =: (null) as an xref for COB 113 ; 114 N X,IBMRA,IBSP 115 S X=0 I $G(ACT),$E($G(ADT),1,7)'?7N S ADT=DT 116 S (IBMRA,IBSP)=0 ;Flag to say if pt has medicare wnr, spouse has policy 117 F S X=$O(^DPT(DFN,.312,X)) Q:'X I $D(^(X,0)) D 118 .I $G(ACT),'$$CHK(^DPT(DFN,.312,X,0),ADT,$G(ACT)) Q 119 .S @VAR@(0)=$G(@VAR@(0))+1 120 .S @VAR@(X,0)=$$ZND(DFN,X) 121 .S @VAR@(X,1)=$G(^DPT(DFN,.312,X,1)) 122 .S @VAR@(X,2)=$G(^DPT(DFN,.312,X,2)) 123 .S @VAR@(X,3)=$G(^DPT(DFN,.312,X,3)) 124 .S @VAR@(X,4)=$G(^DPT(DFN,.312,X,4)) 125 .S @VAR@(X,5)=$G(^DPT(DFN,.312,X,5)) 126 .S @VAR@(X,355.3)=$G(^IBA(355.3,+$P($G(^DPT(DFN,.312,X,0)),"^",18),0)) 127 .I $G(SOP) D 128 ..N COB,WHO 129 ..S COB=$P(@VAR@(X,0),U,20) 130 ..S WHO=$P(@VAR@(X,0),U,6) S:WHO="s" IBSP=1 131 ..I $$MCRWNR^IBEFUNC(+@VAR@(X,0)) D 132 ... S COB=.5,IBMRA=1 133 ... 134 ..S COB=$S(COB'="":COB,WHO="v":1,WHO="s":$S(IBMRA:1,1:2),1:3) 135 ..S @VAR@("S",COB,X)="" 136 ..Q 137 ; Ck for spouse's insurance, move it before any MEDICARE WNR if sorting 138 I $G(SOP),IBMRA,IBSP D 139 . ; Shuffle Medicare WNR, if necessary 140 . S X=0 F S X=$O(@VAR@("S",.5,X)) Q:'X S @VAR@("S",2,X)="" K @VAR@("S",.5,X) 141 . S X=0 F S X=$O(@VAR@("S",2,X)) Q:'X I $P(@VAR@(X,0),U,6)="s",'$P(@VAR@(X,0),U,20) S @VAR@("S",1,X)="" K @VAR@("S",2,X) 142 ALLQ Q 143 ; 144 ALLWNR(DFN,VAR,ADT) ; Returns 'all active and MEDICARE WNR' 145 D ALL(DFN,VAR,4,ADT) 146 Q 147 ; 148 ZND(DFN,NODE) ; -- set group number and group name back into zeroth node of ins. type 149 N X,Y S (X,Y)="" 150 I '$G(DFN)!('$G(NODE)) G ZNDQ 151 S X=$G(^DPT(+DFN,.312,+NODE,0)) 152 S Y=$G(^IBA(355.3,+$P(X,"^",18),0)) I Y="" G ZNDQ 153 S $P(X,"^",3)=$P(Y,"^",4) ; move group number 154 S $P(X,"^",15)=$P(Y,"^",3) ; move group name 155 ; 156 ZNDQ Q X 157 ; 158 INDEM(X) ; -- is this an indemnity plan 159 ; -- input zeroth node if insurance type field 160 N IBINDEM,IBCTP 161 S IBINDEM=1 162 I $P($G(^DIC(36,+X,0)),"^",13)=15 G INDEMQ ; company is indemnity co. 163 S IBCTP=$P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",9) 164 I IBCTP,$P($G(^IBE(355.1,+IBCTP,0)),"^",3)=9 G INDEMQ ; plan is an indemnity plan 165 S IBINDEM=0 166 INDEMQ Q IBINDEM 167 ; 168 ; 169 INSTYP(DFN,DATE) ; -- return type of insurance policy for patient 170 ; 171 ; -- input dfn := pointer to patient file (required) 172 ; date := date of insurance (optional, default = today) 173 ; 174 ; -- output Major Category of type of Plan (file 355.1, field .03) 175 ; for policy which would be billed first (cob) 176 ; null no insurance found 177 ; 1 MAJOR MEDICAL (default) 178 ; 2 DENTAL 179 ; 3 HMO 180 ; 4 PPO 181 ; 5 MEDICARE 182 ; 6 MEDICAID 183 ; 7 TRICARE 184 ; 8 WORKMANS COMP 185 ; 9 INDEMNITY 186 ; 10 PRESCRIPTION 187 ; 11 MEDICARE SUPPLEMENTAL 188 ; 12 ALL OTHER 189 ; 190 N TYPE,POL,IBCPOL 191 S TYPE="" 192 I '$G(DFN) G INSTYPQ 193 I '$G(DATE) S DATE=DT 194 D ALL(DFN,"POL",3,DATE) 195 I $G(POL(0))<1 G INSTYPQ 196 I $G(POL(0))=1 S IBCPOL=+$O(POL(0)) 197 I $G(POL(0))>1 S IBCPOL=$$COB(.POL) 198 ; 199 I IBCPOL S TYPE=$P($G(^IBE(355.1,+$P($G(POL(IBCPOL,355.3)),"^",9),0)),"^",3) 200 I TYPE="" S TYPE=1 ;default is major medical 201 ; 202 INSTYPQ Q TYPE 203 ; 204 COB(POL) ; -- find policy with high coordination of benefits 205 N I,X,IBC,COB,WHO,IBCOB 206 ; 207 S IBC="" 208 S I=0 F S I=$O(POL(I)) Q:'I D 209 .S WHO=$P($G(POL(I,0)),"^",6),COB=$P($G(POL(I,0)),"^",20) 210 .S X=$S(COB'="":COB,WHO="v":1,WHO="s":2,1:3) 211 .I 'IBC S IBC=I,IBCOB=X Q 212 .I X<IBCOB S IBC=I,IBCOB=X 213 Q IBC 1 IBCNS1 ;ALB/AAS - INSURANCE MANAGEMENT SUPPORTED FUNCTIONS ;22-JULY-91 2 ;;2.0;INTEGRATED BILLING;**28,60,52,85,107,51,137,240**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 INSURED(DFN,IBINDT) ; -- Is patient insured 6 ; --Input DFN = patient 7 ; IBINDT = (optional) date insured (default = today) 8 ; -- Output = 0 - not insured 9 ; = 1 - insured 10 ; 11 N J,X,IBINS S IBINS=0,J=0 12 I '$G(DFN) G INSQ 13 I '$G(IBINDT) S IBINDT=DT 14 F S J=$O(^DPT(DFN,.312,J)) Q:'J S X=$G(^(J,0)) S IBINS=$$CHK(X,IBINDT) Q:IBINS 15 INSQ Q IBINS 16 ; 17 PRE(DFN,IBINDT) ; -- is pre-certification required for patient 18 N X,Y,J,IBPRE 19 S IBPRE=0,J=0 20 S:'$G(IBINDT) IBINDT=DT 21 F S J=$O(^DPT(DFN,.312,J)) Q:'J S X=$G(^(J,0)) I $$CHK(X,IBINDT),$P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",6) S IBPRE=1 Q 22 PREQ Q IBPRE 23 ; 24 UR(DFN,IBINDT) ; -- is ur required for patient 25 N X,Y,J,IBPRE 26 S IBUR=0,J=0 27 S:'$G(IBINDT) IBINDT=DT 28 F S J=$O(^DPT(DFN,.312,J)) Q:'J S X=$G(^(J,0)) I $$CHK(X,IBINDT),$P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",5) S IBUR=1 Q 29 URQ Q IBUR 30 ; 31 CHK(X,Z,Y) ; -- check one entry for active 32 ; -- Input X = Zeroth node of entry in insurance multiple (2.312) 33 ; Z = date to check 34 ; Y = 2 if want will not reimburse 35 ; = 3 if want will not reimburse AND indemnity plans 36 ; = 4 if want will not reimburse, but only if it's 37 ; MEDICARE 38 ; -- Output 1 = Insurance Active 39 ; 0 = Inactive 40 ; 41 N Z1,X1 42 S Z1=0,Y=$G(Y) 43 I Y'=3,$$INDEM(X) G CHKQ ; is an indemnity policy or company 44 S X1=$G(^DIC(36,+X,0)) G:X1="" CHKQ ;insurance company entry doesn't exist 45 I $P(X,"^",8) G:Z<$P(X,"^",8) CHKQ ;effective date later than care 46 I $P(X,"^",4) G:Z>$P(X,"^",4) CHKQ ;care after expiration date 47 I $P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",11) G CHKQ ;plan is inactive 48 G:$P(X1,"^",5) CHKQ ;insurance company inactive 49 I Y<2 G:$P(X1,"^",2)="N" CHKQ ;insurance company will not reimburse 50 I Y=4,$P(X1,"^",2)="N",'$$MCRWNR^IBEFUNC(+X) G CHKQ ;only MEDICARE WNR 51 S Z1=1 52 CHKQ Q Z1 53 ; 54 ACTIVE(IBCIFN) ; -- is this company active for this patient for this date 55 ; -- called from input transform and x-refs for fields 101,102,103 56 ; -- input 57 N ACTIVE,DFN,IBINDT 58 S DFN=$P(^DGCR(399,DA,0),"^",2),IBINDT=$S(+$G(^DGCR(399,DA,"U")):+$G(^("U")),1:DT) 59 ; 60 ACTIVEQ Q ACTIVE 61 ; 62 DD ; - called from input transform and x-refs for field 101,102,103 63 ; - input requires da=internal entry number in 399 64 ; - outputs IBdd(ins co.) array 65 N DFN S DFN=$P(^DGCR(399,DA,0),"^",2),IBINDT=$S(+$G(^DGCR(399,DA,"U")):+$G(^("U")),1:DT) 66 D ALLACT 67 DDQ K IBINDT Q 68 ; 69 ; 70 ALLACT ; -- return active insurance zeroth nodes in ibdd(ins co,entry in mult) 71 N X,X1 72 S (X1,IBDD)=0 73 F S X1=$O(^DPT(DFN,.312,X1)) Q:'X1 S X=$G(^(X,0)) I $$CHK(X,IBINDT) S IBDD(+X,X1)=X 74 ; 75 ALLACTQ Q 76 ; 77 HDR W !?4,"Insurance Co.",?22,"Policy #",?40,"Group",?52,"Holder",?60,"Effective",?70,"Expires" S X="",$P(X,"=",IOM-4)="" W !?4,X 78 Q 79 ; 80 ; 81 D1 N X Q:'$D(IBINS) 82 W !?4,$S($D(^DIC(36,+IBINS,0)):$E($P(^(0),"^",1),1,16),1:"UNKNOWN") 83 W ?22,$E($P(IBINS,"^",2),1,16) 84 W ?40,$E($$GRP^IBCNS($P(IBINS,"^",18)),1,10) 85 S X=$P(IBINS,"^",6) W ?52,$S(X="v":"SELF",X="s":"SPOUSE",1:"OTHER") 86 W ?60,$$DAT1^IBOUTL($P(IBINS,"^",8)),?70,$$DAT1^IBOUTL($P(IBINS,"^",4)) 87 Q 88 ; 89 ALL(DFN,VAR,ACT,ADT,SOP) ; -- find all insurance data on a patient 90 ; 91 ; -- input DFN = patient 92 ; VAR = variable to output in format of abc 93 ; or abc(dfn) 94 ; or ^tmp($j,"Insurance") 95 ; ACT = 1 if only active ins. desired 96 ; = 2 if active and will not reimburse desired 97 ; = 3 if active, will not reimburse, and indemnity are 98 ; all desired (for the $$INSTYP function below) 99 ; = 4 if only active and MEDICARE WNR only desired 100 ; ADT = if ACT=1 or 4, then ADT is the internal date to check 101 ; active for, default = dt 102 ; SOP = if SOP=1, then sort policies in COB order 103 ; 104 ; -- output var(0) =: number of entries insurance multiple 105 ; var(x,0) =: ^dpt(dfn,.312,x,0) 106 ; var(x,1) =: ^dpt(dfn,.312,x,1) 107 ; var(x,2) =: ^dpt(dfn,.312,x,2) 108 ; var(x,3) =: ^dpt(dfn,.312,x,3) 109 ; var(x,4) =: ^dpt(dfn,.312,x,4) 110 ; var(x,355.3) =: ^iba(355.3,$p(var(x,0),"^",18),0) 111 ; var("S",COB sequence,x) =: (null) as an xref for COB 112 ; 113 N X,IBMRA,IBSP 114 S X=0 I $G(ACT),$E($G(ADT),1,7)'?7N S ADT=DT 115 S (IBMRA,IBSP)=0 ;Flag to say if pt has medicare wnr, spouse has policy 116 F S X=$O(^DPT(DFN,.312,X)) Q:'X I $D(^(X,0)) D 117 .I $G(ACT),'$$CHK(^DPT(DFN,.312,X,0),ADT,$G(ACT)) Q 118 .S @VAR@(0)=$G(@VAR@(0))+1 119 .S @VAR@(X,0)=$$ZND(DFN,X) 120 .S @VAR@(X,1)=$G(^DPT(DFN,.312,X,1)) 121 .S @VAR@(X,2)=$G(^DPT(DFN,.312,X,2)) 122 .S @VAR@(X,3)=$G(^DPT(DFN,.312,X,3)) 123 .S @VAR@(X,4)=$G(^DPT(DFN,.312,X,4)) 124 .S @VAR@(X,355.3)=$G(^IBA(355.3,+$P($G(^DPT(DFN,.312,X,0)),"^",18),0)) 125 .I $G(SOP) D 126 ..N COB,WHO 127 ..S COB=$P(@VAR@(X,0),U,20) 128 ..S WHO=$P(@VAR@(X,0),U,6) S:WHO="s" IBSP=1 129 ..I $$MCRWNR^IBEFUNC(+@VAR@(X,0)) D 130 ... S COB=.5,IBMRA=1 131 ... 132 ..S COB=$S(COB'="":COB,WHO="v":1,WHO="s":$S(IBMRA:1,1:2),1:3) 133 ..S @VAR@("S",COB,X)="" 134 ..Q 135 ; Ck for spouse's insurance, move it before any MEDICARE WNR if sorting 136 I $G(SOP),IBMRA,IBSP D 137 . ; Shuffle Medicare WNR, if necessary 138 . S X=0 F S X=$O(@VAR@("S",.5,X)) Q:'X S @VAR@("S",2,X)="" K @VAR@("S",.5,X) 139 . S X=0 F S X=$O(@VAR@("S",2,X)) Q:'X I $P(@VAR@(X,0),U,6)="s",'$P(@VAR@(X,0),U,20) S @VAR@("S",1,X)="" K @VAR@("S",2,X) 140 ALLQ Q 141 ; 142 ALLWNR(DFN,VAR,ADT) ; Returns 'all active and MEDICARE WNR' 143 D ALL(DFN,VAR,4,ADT) 144 Q 145 ; 146 ZND(DFN,NODE) ; -- set group number and group name back into zeroth node of ins. type 147 N X,Y S (X,Y)="" 148 I '$G(DFN)!('$G(NODE)) G ZNDQ 149 S X=$G(^DPT(+DFN,.312,+NODE,0)) 150 S Y=$G(^IBA(355.3,+$P(X,"^",18),0)) I Y="" G ZNDQ 151 S $P(X,"^",3)=$P(Y,"^",4) ; move group number 152 S $P(X,"^",15)=$P(Y,"^",3) ; move group name 153 ; 154 ZNDQ Q X 155 ; 156 INDEM(X) ; -- is this an indemnity plan 157 ; -- input zeroth node if insurance type field 158 N IBINDEM,IBCTP 159 S IBINDEM=1 160 I $P($G(^DIC(36,+X,0)),"^",13)=15 G INDEMQ ; company is indemnity co. 161 S IBCTP=$P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",9) 162 I IBCTP,$P($G(^IBE(355.1,+IBCTP,0)),"^",3)=9 G INDEMQ ; plan is an indemnity plan 163 S IBINDEM=0 164 INDEMQ Q IBINDEM 165 ; 166 ; 167 INSTYP(DFN,DATE) ; -- return type of insurance policy for patient 168 ; 169 ; -- input dfn := pointer to patient file (required) 170 ; date := date of insurance (optional, default = today) 171 ; 172 ; -- output Major Category of type of Plan (file 355.1, field .03) 173 ; for policy which would be billed first (cob) 174 ; null no insurance found 175 ; 1 MAJOR MEDICAL (default) 176 ; 2 DENTAL 177 ; 3 HMO 178 ; 4 PPO 179 ; 5 MEDICARE 180 ; 6 MEDICAID 181 ; 7 TRICARE 182 ; 8 WORKMANS COMP 183 ; 9 INDEMNITY 184 ; 10 PRESCRIPTION 185 ; 11 MEDICARE SUPPLEMENTAL 186 ; 12 ALL OTHER 187 ; 188 N TYPE,POL,IBCPOL 189 S TYPE="" 190 I '$G(DFN) G INSTYPQ 191 I '$G(DATE) S DATE=DT 192 D ALL(DFN,"POL",3,DATE) 193 I $G(POL(0))<1 G INSTYPQ 194 I $G(POL(0))=1 S IBCPOL=+$O(POL(0)) 195 I $G(POL(0))>1 S IBCPOL=$$COB(.POL) 196 ; 197 I IBCPOL S TYPE=$P($G(^IBE(355.1,+$P($G(POL(IBCPOL,355.3)),"^",9),0)),"^",3) 198 I TYPE="" S TYPE=1 ;default is major medical 199 ; 200 INSTYPQ Q TYPE 201 ; 202 COB(POL) ; -- find policy with high coordination of benefits 203 N I,X,IBC,COB,WHO,IBCOB 204 ; 205 S IBC="" 206 S I=0 F S I=$O(POL(I)) Q:'I D 207 .S WHO=$P($G(POL(I,0)),"^",6),COB=$P($G(POL(I,0)),"^",20) 208 .S X=$S(COB'="":COB,WHO="v":1,WHO="s":2,1:3) 209 .I 'IBC S IBC=I,IBCOB=X Q 210 .I X<IBCOB S IBC=I,IBCOB=X 211 Q IBC
Note:
See TracChangeset
for help on using the changeset viewer.
