| 1 | IBCNRPMT ;DAOU/ALA - Match Group Plan to Pharmacy Plan ;14-NOV-2003
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;**Program Description**
|
|---|
| 6 | ; This program select an insurance company and displays
|
|---|
| 7 | ; all the active group plans for that insurance company
|
|---|
| 8 | ;
|
|---|
| 9 | EN ; Select an insurance company
|
|---|
| 10 | S DIR(0)="350.9,4.06"
|
|---|
| 11 | S DIR("A")="Select INSURANCE COMPANY",DIR("??")="^D ADH^IBCNSM3"
|
|---|
| 12 | S DIR("?")="Select the Insurance Company for the plan you are entering"
|
|---|
| 13 | D ^DIR K DIR S IBCNSP=+Y I Y<1 G EXIT
|
|---|
| 14 | I $P($G(^DIC(36,+IBCNSP,0)),"^",2)="N" W !,"This company does not reimburse. "
|
|---|
| 15 | I $P($G(^DIC(36,+IBCNSP,0)),"^",5) W !,*7,"Warning: Inactive Company" H 3 K IBCNSP G EXIT
|
|---|
| 16 | ;
|
|---|
| 17 | GRP NEW DIC,DTOUT,DUOUT,X,Y
|
|---|
| 18 | S (IBIND,IBMULT,IBW)=1
|
|---|
| 19 | S DIC(0)="BEFSXZ"
|
|---|
| 20 | S DIC("S")="S DNM=$NA(^(0)),DIEN=$QS(DNM,2),GST=$$GPS^IBCNRPMT(IBCNSP,DIEN),DIEN=$G(@DNM) I GST'=0"
|
|---|
| 21 | S DIC("W")="W $P(^(0),U,3),"" - "",$P(^(0),U,4)"
|
|---|
| 22 | S DIC="^IBA(355.3,"
|
|---|
| 23 | S D="B",X=IBCNSP
|
|---|
| 24 | D IX^DIC I Y<1 G EN
|
|---|
| 25 | S IBCNGP=+Y
|
|---|
| 26 | ;
|
|---|
| 27 | D EN^IBCNRP
|
|---|
| 28 | G EN
|
|---|
| 29 | ;
|
|---|
| 30 | GPS(INIEN,GPIEN) ; screen for valid GIPF
|
|---|
| 31 | ;W !,"***",GPIEN
|
|---|
| 32 | N GST1,GP0,IBCOV,LIM,IBCOV
|
|---|
| 33 | S GST1=1
|
|---|
| 34 | S GP0=$G(^IBA(355.3,GPIEN,0))
|
|---|
| 35 | ;chk insurance company
|
|---|
| 36 | I $P(GP0,U,1)'=INIEN S GST1=0 Q GST1
|
|---|
| 37 | ;chk for active group
|
|---|
| 38 | I $P(GP0,U,11)=1 S GST1=0 Q GST1
|
|---|
| 39 | ;chk for pharm plan coverage
|
|---|
| 40 | S IBCOV=$O(^IBE(355.31,"B","PHARMACY",""))
|
|---|
| 41 | S LIM="",IBCVRD=0
|
|---|
| 42 | F S LIM=$O(^IBA(355.32,"B",GPIEN,LIM)) Q:LIM="" D
|
|---|
| 43 | . I $P(^IBA(355.32,LIM,0),U,2)=IBCOV D
|
|---|
| 44 | .. ;chk covered status
|
|---|
| 45 | .. S IBCVRD=$P(^IBA(355.32,LIM,0),U,4)
|
|---|
| 46 | I IBCVRD=0 S GST1=0
|
|---|
| 47 | ;W !,"***",GPIEN," - ",GST1 ;
|
|---|
| 48 | Q GST1
|
|---|
| 49 | ;
|
|---|
| 50 | EXIT K IBCNSP,IBCPOL,IBIND,IBMULT,IBSEL,IBW,IBALR,IBGRP,IBCNGP
|
|---|
| 51 | Q
|
|---|
