| 1 | DGCRNS ;ALB/AAS - IS INSURANCE ACTIVE ; 22-JULY-91
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | ;Input - DFN = patient
|
|---|
| 5 | ; - DGCRINDT = (optional) date to check ins active for or today if not defined
|
|---|
| 6 | ; - DGCROUTP = (optional) 1 if want active insurance returned in DGCRDD(insurance company)=node in patient file
|
|---|
| 7 | ; - = 2 if want all ins returned
|
|---|
| 8 | ;
|
|---|
| 9 | ;Output - DGCRINS = 1 if has active ins., 0 if no active ins.
|
|---|
| 10 | ; - DGCRDD() = internal node in patient file of valid ins.
|
|---|
| 11 | ; - DGCRDDI() = internal node in patient file of invalid ins.
|
|---|
| 12 | ;
|
|---|
| 13 | % N J,X S DGCRINS=0 K DGCRDD,DGCRDDI
|
|---|
| 14 | S J=0 F S J=$O(^DPT(DFN,.312,J)) Q:'J I $D(^DPT(DFN,.312,J,0)) S X=^(0) D CHK
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | CHK ;
|
|---|
| 18 | ;Input - DGCRI = entry in insurance multiple
|
|---|
| 19 | ;
|
|---|
| 20 | S Z=$S($D(DGCRINDT):DGCRINDT,1:DT),Z1=$S($D(DGCROUTP):DGCROUTP,1:0)
|
|---|
| 21 | G:'$D(^DIC(36,+X,0)) CHKQ S X1=^(0) ;insurance company entry doesn't exist
|
|---|
| 22 | I $P(X,"^",8) G:Z<$P(X,"^",8) CHKQ ;effective date later than care
|
|---|
| 23 | I $P(X,"^",4) G:Z>$P(X,"^",4) CHKQ ;care after expiration date
|
|---|
| 24 | I $P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",11) G CHKQ ;plan is inactive
|
|---|
| 25 | G:$P(X1,"^",5) CHKQ ;insurance company inactive
|
|---|
| 26 | G:$P(X1,"^",2)="N" CHKQ ;insurance company will not reimburse
|
|---|
| 27 | S DGCRINS=1 I Z1 S DGCRDD(+X)=X
|
|---|
| 28 | CHKQ S:Z1=2&('$D(DGCRDD(+X))) DGCRDDI(+X)=X
|
|---|
| 29 | K X,X1,Z,Z1 Q
|
|---|
| 30 | ;
|
|---|
| 31 | DD ; - called from input transform and x-refs for field 101,102,103
|
|---|
| 32 | ; - input requires da=internal entry number in 399
|
|---|
| 33 | ; - outputs dgcrdd(ins co.) array
|
|---|
| 34 | N DFN S DFN=$P(^DGCR(399,DA,0),"^",2),DGCROUTP=1,DGCRINDT=$S(+$G(^DGCR(399,DA,"U")):+$G(^("U")),1:DT)
|
|---|
| 35 | D %
|
|---|
| 36 | DDQ K DGCROUTP,DGCRINDT Q
|
|---|
| 37 | ;
|
|---|
| 38 | ;
|
|---|
| 39 | DISP ; -Display all insurance company information
|
|---|
| 40 | ; -input DFN
|
|---|
| 41 | ;
|
|---|
| 42 | Q:'$D(DFN) D:'$D(IOF) HOME^%ZIS
|
|---|
| 43 | S DGCROUTP=2 D DGCRNS
|
|---|
| 44 | ;
|
|---|
| 45 | D HDR
|
|---|
| 46 | I '$D(DGCRDD),'$D(DGCRDDI) W !,"No Insurance Information" G DISPQ
|
|---|
| 47 | ;
|
|---|
| 48 | S X="" F S X=$O(DGCRDD(X)) Q:X="" S IBINS=DGCRDD(X) D D1 ;active insurance
|
|---|
| 49 | S X="" F S X=$O(DGCRDDI(X)) Q:X="" S IBINS=DGCRDDI(X) D D1 ;inactive ins
|
|---|
| 50 | ;
|
|---|
| 51 | DISPQ K DGCRDD,DGCRDDI,DGCRX
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | HDR W !?4,"Insurance Co.",?22,"Policy #",?40,"Group",?52,"Holder",?60,"Effective",?70,"Expires" S X="",$P(X,"=",IOM-4)="" W !?4,X
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | ;
|
|---|
| 58 | D1 N X Q:'$D(IBINS)
|
|---|
| 59 | W !?4,$S($D(^DIC(36,+IBINS,0)):$E($P(^(0),"^",1),1,16),1:"UNKNOWN")
|
|---|
| 60 | W ?22,$E($P(IBINS,"^",2),1,16),?40,$E($S($P(IBINS,"^",15)'="":$P(IBINS,"^",15),1:$P(IBINS,"^",3)),1,10)
|
|---|
| 61 | S X=$P(IBINS,"^",6) W ?52,$S(X="v":"SELF",X="s":"SPOUSE",1:"OTHER")
|
|---|
| 62 | W ?60,$$DAT1^IBOUTL($P(IBINS,"^",8)),?70,$$DAT1^IBOUTL($P(IBINS,"^",4))
|
|---|
| 63 | Q
|
|---|
