| [613] | 1 | IBCNEPM2 ;DAOU/ESG - PAYER MAINTENANCE ENTRY POINT ;22-JAN-2003
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | EN ; -- main entry point
|
|---|
| 7 | NEW X,Y,DIRUT,DIR,DTOUT,DUOUT,DIROUT
|
|---|
| 8 | W @IOF,!?22,"Payer Maintenance"
|
|---|
| 9 | W !!," This option will allow you to manage and maintain the entries"
|
|---|
| 10 | W !," in the Payer File for those Payers that were added to your system"
|
|---|
| 11 | W !," that are Nationally Active and who have potential missing links"
|
|---|
| 12 | W !," to active insurance companies."
|
|---|
| 13 | W !!," Potential missing links is defined as active insurance companies"
|
|---|
| 14 | W !," whose Professional and/or Institutional ID matches that of the "
|
|---|
| 15 | W !," Payer and whose pointer to the Payer Table is not populated.",!!!
|
|---|
| 16 | ;
|
|---|
| 17 | S DIR(0)="E" D ^DIR
|
|---|
| 18 | I $G(DUOUT)!$G(DTOUT) Q
|
|---|
| 19 | ;
|
|---|
| 20 | W !!?5,"Compiling the list of applicable payers ... "
|
|---|
| 21 | ;
|
|---|
| 22 | ; call ListMan Screen
|
|---|
| 23 | D EN^VALM("IBCNE PAYER MAINT LIST")
|
|---|
| 24 | KILL ^TMP("IBCNEPM",$J)
|
|---|
| 25 | EXIT ;
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | EXPND ; -- expand code for action protocol IBCNE PAYER EXPAND
|
|---|
| 29 | ;
|
|---|
| 30 | NEW LINE,X,Y,DIRUT,DIR,DTOUT,DUOUT,DIROUT,PIEN,PAYER,PAYRDATA
|
|---|
| 31 | NEW PROFID,INSTID
|
|---|
| 32 | D FULL^VALM1 W !
|
|---|
| 33 | ;
|
|---|
| 34 | I 'VALMCNT D G EXPNDXT
|
|---|
| 35 | . W !!?5,"There are no entries in the list."
|
|---|
| 36 | . D PAUSE^VALM1
|
|---|
| 37 | ;
|
|---|
| 38 | ; Ask the user to choose the payer to expand
|
|---|
| 39 | S DIR("A")="Select entry to Expand, by line #"
|
|---|
| 40 | S DIR(0)="NO^1:"_VALMCNT D ^DIR K DIR
|
|---|
| 41 | I $D(DIRUT) K DIRUT G EXPNDXT
|
|---|
| 42 | I $G(DUOUT)!($G(DTOUT)) G EXPNDXT
|
|---|
| 43 | S LINE=+Y
|
|---|
| 44 | S PIEN=$O(^TMP("IBCNEPM",$J,"IDX",LINE,"")) ; payer ien
|
|---|
| 45 | I PIEN="" Q
|
|---|
| 46 | S PAYER=^TMP("IBCNEPM",$J,"IDX",LINE,PIEN) ; payer name
|
|---|
| 47 | S PAYRDATA=$G(^IBE(365.12,PIEN,0))
|
|---|
| 48 | S PROFID=$P(PAYRDATA,U,5),INSTID=$P(PAYRDATA,U,6)
|
|---|
| 49 | D EN^IBCNEPM1(PIEN,PAYER,PROFID,INSTID)
|
|---|
| 50 | EXPNDXT ;
|
|---|
| 51 | S VALMBCK="R"
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
