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 Oct 16, 2024@18:15:35 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 ;
