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

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1IBCF21 ;ALB/ARH - HCFA 1500 19-90 DATA (gather insurance, cc) ;12-JUN-93
2 ;;2.0;INTEGRATED BILLING;**8,80,51**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; requires IBIFN
6INS S IBFLD("11AD")=""
7 F IBI=1,2,3 S IB("I"_IBI)=$G(^DGCR(399,IBIFN,("I"_IBI)))
8 F IBI="I1","I2","I3" I IB(IBI)'="" S IBX=+$P(IB(IBI),U,16),IBY="IBR"_IBI,@IBY=IBX I IBX'=1,IBX'=2 D S @IBY=IBX ;pt's rel to insured
9 . I $P(IB(IBI),U,6)="v" D:'$D(VAEL) ELIG^VADPT I +VAEL(4) S IBX=1 Q ;vet is the patient
10 . I $P(IB(IBI),U,6)="s" D:'$D(VAEL) ELIG^VADPT I +VAEL(4) S IBX=2 Q ;vet is pt, so vets spouse is pt's spouse
11 . I 'IBX S IBX=9 ; else relationship of insured to patient unknown
12 K VAEL
13 ;
14 S IBCOB=$P($G(^DGCR(399,IBIFN,0)),U,21),IBPRIM="I1",IBRIP=$G(IBRI1),IBSECD="I2",IBRIS=$G(IBRI2)
15 I IBCOB="S" S IBPRIM="I2",IBRIP=$G(IBRI2),IBSECD="I1",IBRIS=$G(IBRI1)
16 I IBCOB="T" S IBPRIM="I3",IBRIP=$G(IBRI3),IBSECD="I1",IBRIS=$G(IBRI1)
17 ;
18INS1 G INS2:IB(IBPRIM)=""!('$D(^DIC(36,+IB(IBPRIM),0)))
19 F IBI=$P(IB(IBPRIM),U,2),$P(IB(IBPRIM),U,3) I IBI'="" S IBFLD("1A")=IBI Q ;policy number
20 S IBFLD(4)=$S(IBRIP=1:"SAME",1:$P(IB(IBPRIM),U,17)) ; insureds name
21 S IBFLD(6)=$S('$P(IB(IBPRIM),U,16):IBRIP,1:+$P(IB(IBPRIM),U,16)) ; patient relationship to insured
22 I IBRIP=1!(IBRIP=2) S IBFLD(7)="SAME" ; insured's address
23 ;
24 I $P(IB(IBPRIM),U,2)'="" S IBFLD(11)=$P(IB(IBPRIM),U,3) ; group number
25 I IBRIP=1 S IBFLD("11AD")=IBFLD("3D"),IBFLD("11AX")=IBFLD("3X")
26 I +IBRIP=1,IBFLD("8E")="E" S VAOA("A")=5 D OAD^VADPT S IBFLD("11B")=VAOA(9) K VAOA ;employer
27 I +IBRIP=2 D
28 . I IBFLD("3X")'="" S X="MFM",IBFLD("11AX")=$E(X,$F(X,IBFLD("3X")))
29 . I IBSPE="E" S VAOA("A")=6 D OAD^VADPT S IBFLD("11B")=VAOA(9) K VAOA ;spouses employer
30 S IBFLD("11C")=$P(IB(IBPRIM),U,15)
31 ;
32INS2 G COND:IB(IBSECD)=""!('$D(^DIC(36,+IB(IBSECD),0))) ; secondary insurance
33 S IBFLD("11D")=1
34 S IBFLD(9)=$P(IB(IBSECD),U,17) I IBFLD(9)'="",IBFLD(9)=$P(IB(IBPRIM),U,17) S IBFLD(9)="SAME" ;secondary insureds nam
35 F IBI=$P(IB(IBSECD),U,2),$P(IB(IBSECD),U,3) I IBI'="" S IBFLD("9A")=IBI Q ;policy number
36 I +IBRIS=1 D
37 . S IBFLD("9BD")=IBFLD("3D"),IBFLD("9BX")=IBFLD("3X")
38 . I IBFLD("8E")="E" S VAOA("A")=5 D OAD^VADPT S IBFLD("9C")=VAOA(9) K VAOA ;employer
39 I +IBRIS=2 D
40 . I IBFLD("3X")'="" S X="MFM",IBFLD("9BX")=$E(X,$F(X,IBFLD("3X")))
41 . I IBSPE="E" S VAOA("A")=6 D OAD^VADPT S IBFLD("9C")=VAOA(9) K VAOA ;spouses employer
42 I IBFLD("9A")=$P(IB(IBSECD),U,3) S IBFLD("9D")=$P(IB(IBSECD),U,15) ;group name
43 I IBFLD("9D")="" S IBFLD("9D")=$P($G(^DIC(36,+IB(IBSECD),0)),U) ;company name
44 ;
45COND ;condition related to employment, auto accident (place), other accident
46 S IBI=0 F S IBI=$O(^DGCR(399,IBIFN,"CC",IBI)) Q:'IBI S X=$G(^(IBI,0)) I +X D
47 . S Y=$G(^DGCR(399.1,+X,0)) Q:Y="" I $P(Y,U,2)="02" S IBFLD("10A")=1
48 S IBI=0 F S IBI=$O(^DGCR(399,IBIFN,"OC",IBI)) Q:'IBI S X=$G(^(IBI,0)) I +X D
49 . S Y=$G(^DGCR(399.1,+X,0)) Q:Y=""
50 . I $P(Y,U,9)=1 S IBFLD("10A")=1
51 . I $P(Y,U,9)=2 S IBFLD("10B")=1 S X=$$STATE^IBCF2($P(X,U,3)) I X'="" S IBFLD("10BS")=X
52 . I $P(Y,U,9)=3 S IBFLD("10C")=1
53 . I $P(Y,U,1)="ONSET OF SYMPTOMS/ILLNESS" S IBFLD(15)=$$DATE^IBCF2($P(X,U,2),1) ; see DATES+1^IBCF22
54 ;
55 K IBRI1,IBRI2,IBRI3,IBCOB,IBPRIM,IBSECD,IBRIP,IBRIS
56 D ^IBCF22
57 Q
Note: See TracBrowser for help on using the repository browser.