source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNRPM1.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1IBCNRPM1 ;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 ;
9EN ; 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 ;
18INS ; 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 ;
36GIPF ; 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 ;
61EXIT K IBCNRP,IBCNRI,IBCNRGP
62 K ^TMP("IBCNR",$J)
63 ;
64 Q
Note: See TracBrowser for help on using the repository browser.