IBCNEPM2.m

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 ---IBCNEPM2   1784     printed  Apr 09, 2024@21:03:43                                                                                                                                                                                                    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       ;