- IBCNRPS ;DAOU/CMW - Match Test Payer Sheet to a Pharmacy Plan ;10-DEC-2003
- ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;**Program Description**
- ; This program selects a plan and displays the test payer sheets
- ; associated with a Plan.
- ;
- EN ; Select a plan
- N DIC,D,Y,DTOUT,DUOUT,IBCNSP
- S DIC="^IBCNR(366.03,",DIC(0)="AEMZ" D ^DIC
- I $G(DTOUT)!$G(DUOUT) Q
- I +Y<1 S D="F",DIC="^IBCNR(366.03,",DIC(0)="AEZ" D IX^DIC
- I +Y<1 Q
- S IBCNSP=+Y
- ;
- D EN^IBCNRPSM(IBCNSP)
- ;
- K IBCNSP
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRPS 579 printed Jan 18, 2025@03:17:39 Page 2
- IBCNRPS ;DAOU/CMW - Match Test Payer Sheet to a Pharmacy Plan ;10-DEC-2003
- +1 ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;**Program Description**
- +5 ; This program selects a plan and displays the test payer sheets
- +6 ; associated with a Plan.
- +7 ;
- EN ; Select a plan
- +1 NEW DIC,D,Y,DTOUT,DUOUT,IBCNSP
- +2 SET DIC="^IBCNR(366.03,"
- SET DIC(0)="AEMZ"
- DO ^DIC
- +3 IF $GET(DTOUT)!$GET(DUOUT)
- QUIT
- +4 IF +Y<1
- SET D="F"
- SET DIC="^IBCNR(366.03,"
- SET DIC(0)="AEZ"
- DO IX^DIC
- +5 IF +Y<1
- QUIT
- +6 SET IBCNSP=+Y
- +7 ;
- +8 DO EN^IBCNRPSM(IBCNSP)
- +9 ;
- +10 KILL IBCNSP
- +11 QUIT