- IBCNEPM2 ;DAOU/ESG - PAYER MAINTENANCE ENTRY POINT ;22-JAN-2003
- ;;2.0;INTEGRATED BILLING;**184,668**;21-MAR-94;Build 28
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- EN ; -- main entry point
- NEW X,Y,DIRUT,DIR,DTOUT,DUOUT,DIROUT
- W @IOF,!?22,"Payer Maintenance"
- W !!," This option will allow you to manage and maintain the entries"
- W !," in the Payer File for those Payers that were added to your system"
- W !," that are Nationally Enabled and who have potential missing links"
- W !," to active insurance companies."
- W !!," Potential missing links is defined as active insurance companies"
- W !," whose Professional and/or Institutional ID matches that of the "
- W !," Payer and whose pointer to the Payer Table is not populated.",!!!
- ;
- S DIR(0)="E" D ^DIR
- I $G(DUOUT)!$G(DTOUT) Q
- ;
- W !!?5,"Compiling the list of applicable payers ... "
- ;
- ; call ListMan Screen
- D EN^VALM("IBCNE PAYER MAINT LIST")
- KILL ^TMP("IBCNEPM",$J)
- EXIT ;
- Q
- ;
- EXPND ; -- expand code for action protocol IBCNE PAYER EXPAND
- ;
- NEW LINE,X,Y,DIRUT,DIR,DTOUT,DUOUT,DIROUT,PIEN,PAYER,PAYRDATA
- NEW PROFID,INSTID
- D FULL^VALM1 W !
- ;
- I 'VALMCNT D G EXPNDXT
- . W !!?5,"There are no entries in the list."
- . D PAUSE^VALM1
- ;
- ; Ask the user to choose the payer to expand
- S DIR("A")="Select entry to Expand, by line #"
- S DIR(0)="NO^1:"_VALMCNT D ^DIR K DIR
- I $D(DIRUT) K DIRUT G EXPNDXT
- I $G(DUOUT)!($G(DTOUT)) G EXPNDXT
- S LINE=+Y
- S PIEN=$O(^TMP("IBCNEPM",$J,"IDX",LINE,"")) ; payer ien
- I PIEN="" Q
- S PAYER=^TMP("IBCNEPM",$J,"IDX",LINE,PIEN) ; payer name
- S PAYRDATA=$G(^IBE(365.12,PIEN,0))
- S PROFID=$P(PAYRDATA,U,5),INSTID=$P(PAYRDATA,U,6)
- D EN^IBCNEPM1(PIEN,PAYER,PROFID,INSTID)
- EXPNDXT ;
- S VALMBCK="R"
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEPM2 1784 printed Feb 18, 2025@23:41:18 Page 2
- IBCNEPM2 ;DAOU/ESG - PAYER MAINTENANCE ENTRY POINT ;22-JAN-2003
- +1 ;;2.0;INTEGRATED BILLING;**184,668**;21-MAR-94;Build 28
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- EN ; -- main entry point
- +1 NEW X,Y,DIRUT,DIR,DTOUT,DUOUT,DIROUT
- +2 WRITE @IOF,!?22,"Payer Maintenance"
- +3 WRITE !!," This option will allow you to manage and maintain the entries"
- +4 WRITE !," in the Payer File for those Payers that were added to your system"
- +5 WRITE !," that are Nationally Enabled and who have potential missing links"
- +6 WRITE !," to active insurance companies."
- +7 WRITE !!," Potential missing links is defined as active insurance companies"
- +8 WRITE !," whose Professional and/or Institutional ID matches that of the "
- +9 WRITE !," Payer and whose pointer to the Payer Table is not populated.",!!!
- +10 ;
- +11 SET DIR(0)="E"
- DO ^DIR
- +12 IF $GET(DUOUT)!$GET(DTOUT)
- QUIT
- +13 ;
- +14 WRITE !!?5,"Compiling the list of applicable payers ... "
- +15 ;
- +16 ; call ListMan Screen
- +17 DO EN^VALM("IBCNE PAYER MAINT LIST")
- +18 KILL ^TMP("IBCNEPM",$JOB)
- EXIT ;
- +1 QUIT
- +2 ;
- EXPND ; -- expand code for action protocol IBCNE PAYER EXPAND
- +1 ;
- +2 NEW LINE,X,Y,DIRUT,DIR,DTOUT,DUOUT,DIROUT,PIEN,PAYER,PAYRDATA
- +3 NEW PROFID,INSTID
- +4 DO FULL^VALM1
- WRITE !
- +5 ;
- +6 IF 'VALMCNT
- Begin DoDot:1
- +7 WRITE !!?5,"There are no entries in the list."
- +8 DO PAUSE^VALM1
- End DoDot:1
- GOTO EXPNDXT
- +9 ;
- +10 ; Ask the user to choose the payer to expand
- +11 SET DIR("A")="Select entry to Expand, by line #"
- +12 SET DIR(0)="NO^1:"_VALMCNT
- DO ^DIR
- KILL DIR
- +13 IF $DATA(DIRUT)
- KILL DIRUT
- GOTO EXPNDXT
- +14 IF $GET(DUOUT)!($GET(DTOUT))
- GOTO EXPNDXT
- +15 SET LINE=+Y
- +16 ; payer ien
- SET PIEN=$ORDER(^TMP("IBCNEPM",$JOB,"IDX",LINE,""))
- +17 IF PIEN=""
- QUIT
- +18 ; payer name
- SET PAYER=^TMP("IBCNEPM",$JOB,"IDX",LINE,PIEN)
- +19 SET PAYRDATA=$GET(^IBE(365.12,PIEN,0))
- +20 SET PROFID=$PIECE(PAYRDATA,U,5)
- SET INSTID=$PIECE(PAYRDATA,U,6)
- +21 DO EN^IBCNEPM1(PIEN,PAYER,PROFID,INSTID)
- EXPNDXT ;
- +1 SET VALMBCK="R"
- +2 QUIT
- +3 ;
