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 Dec 13, 2024@02:16:26 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