- IBCNRPMT ;DAOU/ALA - Match Group Plan to Pharmacy Plan ;14-NOV-2003
- ;;2.0;INTEGRATED BILLING;**251,516**;21-MAR-94;Build 123
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;**Program Description**
- ; This program select an insurance company and displays
- ; all the active group plans for that insurance company
- ;
- EN ; Select an insurance company
- S DIR(0)="350.9,4.06"
- S DIR("A")="Select INSURANCE COMPANY",DIR("??")="^D ADH^IBCNSM3"
- S DIR("?")="Select the Insurance Company for the plan you are entering"
- D ^DIR K DIR S IBCNSP=+Y I Y<1 G EXIT
- I $P($G(^DIC(36,+IBCNSP,0)),"^",2)="N" W !,"This company does not reimburse. "
- I $P($G(^DIC(36,+IBCNSP,0)),"^",5) W !,*7,"Warning: Inactive Company" H 3 K IBCNSP G EXIT
- ;
- GRP NEW DIC,DTOUT,DUOUT,X,Y
- S (IBIND,IBMULT,IBW)=1
- S DIC(0)="BEFSXZ"
- S DIC("S")="S DNM=$NA(^(0)),DIEN=$QS(DNM,2),GST=$$GPS^IBCNRPMT(IBCNSP,DIEN),DIEN=$G(@DNM) I GST'=0"
- ; MRD;IB*2.0*516 - Look at new fields for Group Name and Number.
- ;S DIC("W")="W $P(^(0),U,3),"" - "",$P(^(0),U,4)"
- S DIC("W")="W $P(^(2),U,1),"" - "",$P(^(2),U,2)"
- S DIC="^IBA(355.3,"
- S D="B",X=IBCNSP
- D IX^DIC I Y<1 G EN
- S IBCNGP=+Y
- ;
- D EN^IBCNRP
- G EN
- ;
- GPS(INIEN,GPIEN) ; screen for valid GIPF
- ;W !,"***",GPIEN
- N GST1,GP0,IBCOV,LIM,IBCOV
- S GST1=1
- S GP0=$G(^IBA(355.3,GPIEN,0))
- ;chk insurance company
- I $P(GP0,U,1)'=INIEN S GST1=0 Q GST1
- ;chk for active group
- I $P(GP0,U,11)=1 S GST1=0 Q GST1
- ;chk for pharm plan coverage
- S IBCOV=$O(^IBE(355.31,"B","PHARMACY",""))
- S LIM="",IBCVRD=0
- F S LIM=$O(^IBA(355.32,"B",GPIEN,LIM)) Q:LIM="" D
- . I $P(^IBA(355.32,LIM,0),U,2)=IBCOV D
- .. ;chk covered status
- .. S IBCVRD=$P(^IBA(355.32,LIM,0),U,4)
- I IBCVRD=0 S GST1=0
- ;W !,"***",GPIEN," - ",GST1 ;
- Q GST1
- ;
- EXIT K IBCNSP,IBCPOL,IBIND,IBMULT,IBSEL,IBW,IBALR,IBGRP,IBCNGP
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRPMT 1864 printed Feb 18, 2025@23:42:49 Page 2
- IBCNRPMT ;DAOU/ALA - Match Group Plan to Pharmacy Plan ;14-NOV-2003
- +1 ;;2.0;INTEGRATED BILLING;**251,516**;21-MAR-94;Build 123
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;**Program Description**
- +5 ; This program select an insurance company and displays
- +6 ; all the active group plans for that insurance company
- +7 ;
- EN ; Select an insurance company
- +1 SET DIR(0)="350.9,4.06"
- +2 SET DIR("A")="Select INSURANCE COMPANY"
- SET DIR("??")="^D ADH^IBCNSM3"
- +3 SET DIR("?")="Select the Insurance Company for the plan you are entering"
- +4 DO ^DIR
- KILL DIR
- SET IBCNSP=+Y
- IF Y<1
- GOTO EXIT
- +5 IF $PIECE($GET(^DIC(36,+IBCNSP,0)),"^",2)="N"
- WRITE !,"This company does not reimburse. "
- +6 IF $PIECE($GET(^DIC(36,+IBCNSP,0)),"^",5)
- WRITE !,*7,"Warning: Inactive Company"
- HANG 3
- KILL IBCNSP
- GOTO EXIT
- +7 ;
- GRP NEW DIC,DTOUT,DUOUT,X,Y
- +1 SET (IBIND,IBMULT,IBW)=1
- +2 SET DIC(0)="BEFSXZ"
- +3 SET DIC("S")="S DNM=$NA(^(0)),DIEN=$QS(DNM,2),GST=$$GPS^IBCNRPMT(IBCNSP,DIEN),DIEN=$G(@DNM) I GST'=0"
- +4 ; MRD;IB*2.0*516 - Look at new fields for Group Name and Number.
- +5 ;S DIC("W")="W $P(^(0),U,3),"" - "",$P(^(0),U,4)"
- +6 SET DIC("W")="W $P(^(2),U,1),"" - "",$P(^(2),U,2)"
- +7 SET DIC="^IBA(355.3,"
- +8 SET D="B"
- SET X=IBCNSP
- +9 DO IX^DIC
- IF Y<1
- GOTO EN
- +10 SET IBCNGP=+Y
- +11 ;
- +12 DO EN^IBCNRP
- +13 GOTO EN
- +14 ;
- GPS(INIEN,GPIEN) ; screen for valid GIPF
- +1 ;W !,"***",GPIEN
- +2 NEW GST1,GP0,IBCOV,LIM,IBCOV
- +3 SET GST1=1
- +4 SET GP0=$GET(^IBA(355.3,GPIEN,0))
- +5 ;chk insurance company
- +6 IF $PIECE(GP0,U,1)'=INIEN
- SET GST1=0
- QUIT GST1
- +7 ;chk for active group
- +8 IF $PIECE(GP0,U,11)=1
- SET GST1=0
- QUIT GST1
- +9 ;chk for pharm plan coverage
- +10 SET IBCOV=$ORDER(^IBE(355.31,"B","PHARMACY",""))
- +11 SET LIM=""
- SET IBCVRD=0
- +12 FOR
- SET LIM=$ORDER(^IBA(355.32,"B",GPIEN,LIM))
- if LIM=""
- QUIT
- Begin DoDot:1
- +13 IF $PIECE(^IBA(355.32,LIM,0),U,2)=IBCOV
- Begin DoDot:2
- +14 ;chk covered status
- +15 SET IBCVRD=$PIECE(^IBA(355.32,LIM,0),U,4)
- End DoDot:2
- End DoDot:1
- +16 IF IBCVRD=0
- SET GST1=0
- +17 ;W !,"***",GPIEN," - ",GST1 ;
- +18 QUIT GST1
- +19 ;
- EXIT KILL IBCNSP,IBCPOL,IBIND,IBMULT,IBSEL,IBW,IBALR,IBGRP,IBCNGP
- +1 QUIT