| [613] | 1 | IBCNRPM1 ;DAOU/CMW - Match Multiple Group Plans to a Pharmacy Plan ;10-MAR-2004
|
|---|
| 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 selects a plan and displays the
|
|---|
| 7 | ; Test Payer Sheets associated to the Plan.
|
|---|
| 8 | ;
|
|---|
| 9 | EN ; Select a plan
|
|---|
| 10 | NEW DA,DIC,DIE,DR,D,Y
|
|---|
| 11 | S DIC="^IBCNR(366.03,",DIC(0)="ABEMZ",DIC("A")="Select PHARMACY PLAN: "
|
|---|
| 12 | D ^DIC I X="^" G EXIT
|
|---|
| 13 | K DIC("A")
|
|---|
| 14 | I +Y<1 S D="F",DIC="^IBCNR(366.03,",DIC(0)="AEMNZ" D IX^DIC
|
|---|
| 15 | I +Y<1 G EXIT
|
|---|
| 16 | S IBCNRP=+Y
|
|---|
| 17 | ;
|
|---|
| 18 | INS ; Select an insurance company
|
|---|
| 19 | NEW DA,DIC,DIE,DR,D,Y,IBIND,IBMULT,IBW
|
|---|
| 20 | S (IBIND,IBMULT,IBW)=1
|
|---|
| 21 | S DIR(0)="350.9,4.06"
|
|---|
| 22 | S DIR("A")="Select INSURANCE COMPANY",DIR("??")="^D ADH^IBCNSM3"
|
|---|
| 23 | S DIR("?")="Select the Insurance Company for the plan you are entering"
|
|---|
| 24 | D ^DIR K DIR S IBCNRI=+Y I Y<1 G EN
|
|---|
| 25 | I $P($G(^DIC(36,+IBCNRI,0)),"^",2)="N" W !,"This company does not reimburse. " G INS
|
|---|
| 26 | I $P($G(^DIC(36,+IBCNRI,0)),"^",5) W !,*7,"Warning: Inactive Company" G INS
|
|---|
| 27 | ;
|
|---|
| 28 | D GIPF
|
|---|
| 29 | I '$D(^TMP("IBCNR",$J,"GP")) D G INS
|
|---|
| 30 | . W !,*7,"** No active Group Plans with Pharmacy coverage found for this Insurance Co."
|
|---|
| 31 | ;
|
|---|
| 32 | D EN^IBCNRPM2(IBCNRP,IBCNRI,.IBCNRGP)
|
|---|
| 33 | ;
|
|---|
| 34 | G INS
|
|---|
| 35 | ;
|
|---|
| 36 | GIPF ; screen for valid GIPF
|
|---|
| 37 | ;
|
|---|
| 38 | N GST1,GP0,GP6,IBCOV,LIM,IBCVRD
|
|---|
| 39 | N GPIEN,GPNAM,GPNUM
|
|---|
| 40 | S GST1=1,GPIEN=""
|
|---|
| 41 | K ^TMP("IBCNR",$J,"GP")
|
|---|
| 42 | F S GPIEN=$O(^IBA(355.3,"B",IBCNRI,GPIEN)) Q:GPIEN="" D
|
|---|
| 43 | . ;chk for active group
|
|---|
| 44 | . S GP0=$G(^IBA(355.3,GPIEN,0)),GP6=$G(^IBA(355.3,GPIEN,6))
|
|---|
| 45 | . I $P(GP0,U,11)=1 Q
|
|---|
| 46 | . ;chk for pharm plan coverage
|
|---|
| 47 | . S IBCOV=$O(^IBE(355.31,"B","PHARMACY",""))
|
|---|
| 48 | . S LIM="",IBCVRD=0
|
|---|
| 49 | . F S LIM=$O(^IBA(355.32,"B",GPIEN,LIM)) Q:LIM="" D
|
|---|
| 50 | .. I $P(^IBA(355.32,LIM,0),U,2)=IBCOV D
|
|---|
| 51 | ... ;chk covered status
|
|---|
| 52 | ... S IBCVRD=$P(^IBA(355.32,LIM,0),U,4)
|
|---|
| 53 | ... I IBCVRD=0 Q
|
|---|
| 54 | ... S GPNAM=$P($G(GP0),U,3),GPNUM=$P($G(GP0),U,4)
|
|---|
| 55 | ... I $G(GPNAM)="" S GPNAM="<blank>"
|
|---|
| 56 | ... I $G(GPNUM)="" S GPNUM="<blank>"
|
|---|
| 57 | ... ;set array = pharm plan and plan type
|
|---|
| 58 | ... S ^TMP("IBCNR",$J,"GP",GPNAM,GPNUM,GPIEN)=$P($G(GP6),U)_"^"_$P($G(GP0),U,9)
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | EXIT K IBCNRP,IBCNRI,IBCNRGP
|
|---|
| 62 | K ^TMP("IBCNR",$J)
|
|---|
| 63 | ;
|
|---|
| 64 | Q
|
|---|
