| 1 | IBTRC2 ;ALB/AAS - INSURANCE POLICY CALLS FROM FILE 356.2 DD ; 22-JULY-91
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | DD(IBX,IBDA) ; - called from input transform for field 1.05
|
|---|
| 7 | ; -- input ibx = x from input transform
|
|---|
| 8 | ; ibda = internal entry in 356.2
|
|---|
| 9 | ; -- output returns x=internal entry in 2.3121 (ins. Mult.) if valid
|
|---|
| 10 | ;
|
|---|
| 11 | N DFN,INSDT,ACTIVE,IBDD,IBD,IBCDFN,DA,DR,DIC,DIE
|
|---|
| 12 | D VAR
|
|---|
| 13 | S X=$$SEL^IBCNS2(IBX,DFN,DT,ACTIVE)
|
|---|
| 14 | I +X<1 K X
|
|---|
| 15 | DDQ Q
|
|---|
| 16 | ;
|
|---|
| 17 | VAR S DFN=$P(^IBT(356.2,IBDA,0),"^",5)
|
|---|
| 18 | I DFN="" S DFN=$P($G(^IBT(356,+$P(^IBT(356.2,IBDA,0),"^",2),0)),"^",2)
|
|---|
| 19 | S ACTIVE=2,INSDT=DT
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | SEL(IBX,DFN,INSDT,ACTIVE) ; -- Select insurance policy
|
|---|
| 23 | ; -- Input IBX = x from input transform
|
|---|
| 24 | ; DFN = patient
|
|---|
| 25 | ; INSDT = (optional) Active date of ins. (default = dt)
|
|---|
| 26 | ; ACTIVE = (optional) 1 if want active (default)
|
|---|
| 27 | ; = 2 if want all ins returned
|
|---|
| 28 | ;
|
|---|
| 29 | ; -- Output = pointer to 36 ^ pointer to 2.3121 ^ pointer to 355.3
|
|---|
| 30 | ;
|
|---|
| 31 | N I,J,Y,DA,DE,DQ,DR,DIC,DIE,DIR,DIV,IBSEL,IBDD,IBD
|
|---|
| 32 | S IBSEL=1,Y=""
|
|---|
| 33 | I '$G(ACTIVE) S ACTIVE=2
|
|---|
| 34 | S:'$G(INSDT) INSDT=DT
|
|---|
| 35 | I '$G(DFN) G SELQ
|
|---|
| 36 | D BLD
|
|---|
| 37 | ;
|
|---|
| 38 | ; -- call DIC to choose from list
|
|---|
| 39 | S X=IBX
|
|---|
| 40 | S DIC="^DPT("_DFN_",.312,",DIC(0)="EQMN"
|
|---|
| 41 | S DIC("S")="I $D(IBDD(+Y))"
|
|---|
| 42 | S DIC("W")="W $P(^DIC(36,+^(0),0),U)_"" Group: ""_$$GRP^IBCNS($P(^DPT(DFN,.312,+Y,0),U,18))"
|
|---|
| 43 | D ^DIC
|
|---|
| 44 | SELQ Q +Y
|
|---|
| 45 | ;
|
|---|
| 46 | BLD K IBD,IBDD
|
|---|
| 47 | S (IBDD,IBCDFN)=0 F S IBCDFN=$O(^DPT(+DFN,.312,IBCDFN)) Q:'IBCDFN I $D(^DPT(DFN,.312,+IBCDFN,0)) D CHK(IBCDFN,ACTIVE,INSDT)
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | CHK(IBCDFN,ACTIVE,INSDT) ; -- see if active
|
|---|
| 51 | N X,X1
|
|---|
| 52 | S X=$G(^DPT(DFN,.312,IBCDFN,0))
|
|---|
| 53 | S IBDD(IBCDFN)=+X_"^"_IBCDFN_"^"_$P(X,"^",18)
|
|---|
| 54 | I ACTIVE=2 G CHKQ
|
|---|
| 55 | S X1=$G(^DIC(36,+X,0)) I X1="" G CQ ;ins co entry doesn't exist
|
|---|
| 56 | I $P(X,"^",8) G:INSDT<$P(X,"^",8) CQ ;effective date later than care
|
|---|
| 57 | I $P(X,"^",4) G:INSDT>$P(X,"^",4) CQ ;care after expiration date
|
|---|
| 58 | I $P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",11) G CQ ;plan is inactive
|
|---|
| 59 | G:$P(X1,"^",5) CQ ; ;ins company inactive
|
|---|
| 60 | G:$P(X1,"^",2)="N" CQ ; ;ins company will not reimburse
|
|---|
| 61 | G CHKQ
|
|---|
| 62 | CQ K IBDD(IBCDFN)
|
|---|
| 63 | CHKQ S:$D(IBDD(IBCDFN)) IBDD=IBDD+1,IBD(IBDD)=IBCDFN
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | ;
|
|---|
| 67 | DDHELP(IBDA) ; -- Executable help
|
|---|
| 68 | ; -- write out list to choose from
|
|---|
| 69 | N DFN,INSDT,ACTIVE,IBDD,IBD,IBCDFN,I,IBINS
|
|---|
| 70 | D VAR,BLD
|
|---|
| 71 | ;
|
|---|
| 72 | I $G(IBDD)=0 W !,"No Insurance Policies to Select From" G DDHQ
|
|---|
| 73 | ;
|
|---|
| 74 | I '$D(IOM) D HOME^%ZIS
|
|---|
| 75 | W ! D HDR^IBCNS
|
|---|
| 76 | S I=0 F S I=$O(IBD(I)) Q:'I D
|
|---|
| 77 | .S IBINS=$G(^DPT(DFN,.312,$G(IBD(I)),0))
|
|---|
| 78 | .D D1^IBCNS
|
|---|
| 79 | DDHQ Q
|
|---|
| 80 | ;
|
|---|
| 81 | TRANS(IBDA,Y) ; -- output transform
|
|---|
| 82 | N DFN,INSDT,ACTIVE,IBDD,IBD,IBCDFN
|
|---|
| 83 | D VAR
|
|---|
| 84 | S Y=$P($G(^DIC(36,+$P($G(^DPT(DFN,.312,+$G(Y),0)),U),0)),U)
|
|---|
| 85 | Q Y
|
|---|
| 86 | ;
|
|---|
| 87 | INSCO(IBDA,IBCDFN) ; -- return pointer value of 36 from pt. file
|
|---|
| 88 | N DFN,INSDT,ACTIVE,IBDD,IBD
|
|---|
| 89 | D VAR
|
|---|
| 90 | S Y=+$G(^DPT(DFN,.312,IBCDFN,0))
|
|---|
| 91 | Q Y_$S(Y>0:"^"_$P($G(^DIC(36,+Y,0)),"^"),1:"")
|
|---|
