IBCNEPY ;DAOU/BHS - eIV PAYER EDIT OPTION ;28-JUN-2002
;;2.0;INTEGRATED BILLING;**184,416,668,687,732,737**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
;IB*737/TAZ - Remove references to "~NO PAYER"
;
; Tag HELP1 calls EN^DDIOL
; Reference to EN^DDIOL in ICR #10142
; Call only from a tag
;
EN ; Main entry point
; Input: n/a
; Output: Modifies entries in the Payer File (#365.12)
;
; Initialize variables
NEW PYRIEN
;
D CLRSCRN
F S PYRIEN=$$PAYER() Q:'PYRIEN D EDIT(PYRIEN)
;
ENX ; EN exit point
Q
;
CLRSCRN ;
W @IOF
W !?35,"Payer Edit"
;/vd-IB*2*687 - Changed the following informative text.
W !!,"This option displays the data in the Payer file for a given payer. You"
W !,"may only edit site controlled fields and most fields are not site controlled."
W !,"Site controlled fields cannot be edited for a deactivated payer."
Q
;
EDIT(PIEN) ; Modify Payer application settings -/vd-IB*2*687 - Changed the variable IEN to PIEN
; Input: IEN - key to Payer File (#365.12)
; Output: Modifies entries in the Payer File
;
; Initialize variables
;NEW IBDATA,LN,APPIEN ;/vd-IB*2*687 - Replaced this line with the following line.
;IB*732/CKB - added ISBLUE
N ARRAYEIV,ARRAYIIU,DEACT,EIVIENS,IBDATA,IENEIV,IENIIU,IIUIENS,ISBLUE,LN,LNLFT,LNRHT
;
;S LN=26 ;/vd-IB*2*687 - Replaced this line.
;/vd-IB*2*687 - Beginning of new code.
S IENEIV=$$FIND1^DIC(365.13,,,"EIV"),IENIIU=$$FIND1^DIC(365.13,,,"IIU")
S LN=40 ;Set LN to center the Payer display
S LNLFT=27,LNRHT=37 ; Set LEFT and RIGHT column positions for alignment
;/vd-IB*2*687 - End of new code.
;
; Display non-editable fields:
; Payer Name, VA National ID, CMS National ID, Date/Time Created,
; EDI ID Number - Prof., EDI ID Number - Inst.
S IBDATA=$G(^IBE(365.12,+PIEN,0)) ;/vd-IB*2*687 - Changed the variable IEN to PIEN
;
D CLRSCRN
;IB*737/CKB - allow for large Payer names by centering the Payer Name
N PNCTR,PNLEN
S PNLEN=$L($P(IBDATA,U,1))
I PNLEN>73 W !!,"Payer: "_$P(IBDATA,U,1)
I PNLEN<73 S PNCTR=(80-(PNLEN+7))/2 W !!,?PNCTR,"Payer: ",$P(IBDATA,U,1),!
W !,$$FO^IBCNEUT1("VA National ID: ",LN,"R"),$P(IBDATA,U,2)
W !,$$FO^IBCNEUT1("CMS National ID: ",LN,"R"),$P(IBDATA,U,3)
;IB*732/CKB - display Blue Payer indicator if populated with 1-YES
; NOTE: FSC refers to this field as ISBLUE
I +$P(IBDATA,U,9) S ISBLUE=$P(IBDATA,U,9) D
. W !,$$FO^IBCNEUT1("Blue Payer: ",LN,"R"),$S(+ISBLUE:"YES",1:"NO")
W !,$$FO^IBCNEUT1("Inst Electronic Bill ID: ",LN,"R"),$P(IBDATA,U,6)
W !,$$FO^IBCNEUT1("Prof Electronic Bill ID: ",LN,"R"),$P(IBDATA,U,5)
W !,$$FO^IBCNEUT1("Date/Time Created: ",LN,"R"),$$FMTE^XLFDT($P(IBDATA,U,4),"5Z")
;
;/vd-IB*2.0*687 - Replaced the following commented out lines of code.
;**************************************************************************
; Edit only the eIV payer application - IB*2*416
;IB*668/TAZ - Changed Payer Application from IIV to EIV
;S APPIEN=+$$PYRAPP^IBCNEUT5("EIV",+IEN)
;I 'APPIEN D Q
;. W !!,"There is no eIV payer application defined for this Payer."
;. W ! S DIR(0)="E" D ^DIR K DIR W !
;. Q
;;
;D APPEDIT(+IEN,+APPIEN) ; +APPIEN is always the eIV payer application
;Q
;;
;APPEDIT(PIEN,AIEN) ; Modify eIV Payer application settings
;; Input: PIEN - key to Payer File (#365.12),
;; AIEN - key to Payer Application File (#365.13) - eIV payer application
;; Output: Modifies entries in the Payer File
;;
;; Initialize variables
;;IB*668/TAZ - Added DEACT to NEW statement
;NEW DEACT,IBNODE,LN,FDA,DR,DA,DTOUT,DIE,DIRUT,DIR,X,Y
;;
;; Determine if the application is already defined for the Payer
;S LN=35
;S IBNODE=$G(^IBE(365.12,+PIEN,1,+AIEN,0))
;W !
;;
;I IBNODE="" W !,"eIV Payer Application not found - ERROR!" S DIR(0)="E" D ^DIR K DIR G APPEDX
;;
;;IB*668/TAZ - Changed Active to Enabled in field name and display
;; Display non-editable fields:
;W !,$$FO^IBCNEUT1("Payer Application: ",LN,"R"),"eIV"
;W !,$$FO^IBCNEUT1("Nationally Enabled: ",LN,"R"),$S(+$P(IBNODE,U,2):"Enabled",1:"Not Enabled")
;;IB*668/TAZ - Changed location for Future and Past Service date as well as Auto-Update
;W !,$$FO^IBCNEUT1("Future Service Days: ",LN,"R"),$$GET1^DIQ(365.121,+AIEN_","_PIEN_",",4.03)
;W !,$$FO^IBCNEUT1("Past Service Days: ",LN,"R"),$$GET1^DIQ(365.121,+AIEN_","_PIEN_",",4.04)
;W !,$$FO^IBCNEUT1("Auto-update Pt. Insurance: ",LN,"R"),$$GET1^DIQ(365.121,+AIEN_","_PIEN_",",4.01)
;;IB*668/TAZ - Changed how Deactivated is determined and changed Active to Enabled
;; Display deactivation info only when it exists
;S DEACT=$$PYRDEACT^IBCNINSU(+PIEN)
;I +DEACT D G APPEDX
;. W !,$$FO^IBCNEUT1("Deactivated: ",LN,"R"),$S(+DEACT:"YES",1:"NO")
;. W !,$$FO^IBCNEUT1("Deactivation Date/Time: ",LN,"R"),$S(+$P(DEACT,U,2):$$FMTE^XLFDT($P(DEACT,U,2),"5Z"),1:"")
;. ; Locally Enabled is non-editable if application is deactivated
;. W !,$$FO^IBCNEUT1("Locally Enabled: ",LN,"R"),$S(+$P(IBNODE,U,3):"Enabled",1:"Not Enabled")
;;
;; Allow user to edit Locally Enabled flag
;; Also file the user who edited this local flag and the date/time
;S DR=".03 Locally Enabled;.04////"_$G(DUZ)_";.05////"_$$NOW^XLFDT
;S DIE="^IBE(365.12,"_+PIEN_",1,"
;S DA=+AIEN,DA(1)=+PIEN
;D ^DIE
;;
;APPEDX Q
;/vd-IB*2.0*687 - End of commented out code.
;**************************************************************************
;/vd-IB*2.0*687 - Beginning of new code. Moved the Deactivation check and display to here
S DEACT=$$PYRDEACT^IBCNINSU(+PIEN) ; Get Deactivated data.
I +DEACT D ; If deactivated, display the deactivation information.
. W !,$$FO^IBCNEUT1("Deactivated: ",LN,"R"),$S(+DEACT:"YES",1:"NO")
. W !,$$FO^IBCNEUT1("Deactivation Date/Time: ",LN,"R"),$S(+$P(DEACT,U,2):$$FMTE^XLFDT($P(DEACT,U,2),"5Z"),1:"")
;
;/vd-IB*2*687 - Modified the display of applications to handle both eIV and IIU.
S IENEIV=+$$PYRAPP^IBCNEUT5("EIV",+PIEN) ; Get the ien of the EIV application
S IENIIU=+$$PYRAPP^IBCNEUT5("IIU",+PIEN) ; Get the ien of the IIU application
;
I 'IENEIV,'IENIIU D Q ; No applications for this Payer.
. W !!,"There are no eIV or IIU payer applications defined for this Payer."
. W ! S DIR(0)="E" D ^DIR K DIR W !
;
K ARRAYEIV,ARRAYIIU
I IENEIV D
. D PAYER^IBCNINSU(+PIEN,"EIV","*","E",.ARRAYEIV) ; Get the Payer's EIV data.
. S EIVIENS=$O(ARRAYEIV(365.121,""))
I IENIIU D
. D PAYER^IBCNINSU(+PIEN,"IIU","*","E",.ARRAYIIU) ; Get the Payer's IIU data.
. S IIUIENS=$O(ARRAYIIU(365.121,""))
I 'IENEIV S LNRHT=LNLFT ; There's no EIV data to display, so the IIU data displays on the left.
;
D APPDSPLY ; Display the Application(s) data.
I +DEACT Q ; Do not attempt to Edit the editable fields if Deactivated.
D APPEDIT ; Edit the Application Fields that are editable.
Q
;
APPDSPLY ; Display Application Data
N DASHES,OFFSET
S $P(DASHES,"-",80)="-"
W !!,$$FO^IBCNEUT1("Payer Application: ",LNLFT,"R"),$S(+IENEIV:"eIV",1:"IIU")
I +IENEIV,+IENIIU S OFFSET=4 W $$FO^IBCNEUT1("Payer Application: ",(LNRHT-OFFSET),"R"),"IIU"
;
W !,$E(DASHES,1,38) I +IENEIV,+IENIIU W ?40,$E(DASHES,1,35)
W !
S OFFSET=0
I +IENEIV D
. W $$FO^IBCNEUT1("Nationally Enabled: ",LNLFT,"R")
. W $G(ARRAYEIV(365.121,EIVIENS,.02,"E"))
. S OFFSET=$L($G(ARRAYEIV(365.121,EIVIENS,.02,"E")))+1
I +IENIIU D
. W $$FO^IBCNEUT1("Nationally Enabled: ",(LNRHT-OFFSET),"R")
. W $G(ARRAYIIU(365.121,IIUIENS,.02,"E"))
;
W !
S OFFSET=0
I +IENEIV D
. W $$FO^IBCNEUT1("Future Service Days: ",LNLFT,"R")
. W $G(ARRAYEIV(365.121,EIVIENS,4.03,"E"))
. S OFFSET=$L($G(ARRAYEIV(365.121,EIVIENS,4.03,"E")))+1
I +IENIIU D
. W $$FO^IBCNEUT1("IIU Locally Enabled: ",(LNRHT-OFFSET),"R")
. W $G(ARRAYIIU(365.121,IIUIENS,.03,"E"))
;
W !
S OFFSET=0
I +IENEIV D
. W $$FO^IBCNEUT1("Past Service Days: ",LNLFT,"R")
. W $G(ARRAYEIV(365.121,EIVIENS,4.04,"E"))
. S OFFSET=$L($G(ARRAYEIV(365.121,EIVIENS,4.04,"E")))+1
I +IENIIU D
. W $$FO^IBCNEUT1("Receive IIU Data: ",(LNRHT-OFFSET),"R")
. W $G(ARRAYIIU(365.121,IIUIENS,5.01,"E"))
;
I +IENEIV D
. W !,$$FO^IBCNEUT1("Auto-update Pt. Insurance: ",LNLFT,"R")
. W $G(ARRAYEIV(365.121,EIVIENS,4.01,"E"))
. W !,$$FO^IBCNEUT1("eIV Locally Enabled: ",LNLFT,"R")
. W $G(ARRAYEIV(365.121,EIVIENS,.03,"E"))
;
W !
Q
;
;/vd-IB*2*687 - Modified APPEDIT for Editable fields for eIV and IIU applications.
APPEDIT ; Edit the Payer Application fields that are editable.
N FDA,DR,DA,DTOUT,DIE,DIRUT,DIR,OPTOUT,X,Y
S OPTOUT=0
I +IENEIV D Q:OPTOUT ; Allow user to edit eIV Locally Enabled flag
. S DR=".03 eIV App > eIV Locally Enabled"
. S DR=DR_";.04////"_$G(DUZ)_";.05////"_$$NOW^XLFDT
. S DIE="^IBE(365.12,"_+PIEN_",1,"
. S DA=+IENEIV,DA(1)=+PIEN
. D ^DIE S:$D(Y) OPTOUT=1 K DIE,DA,DR
;
I +IENIIU D ; Allow user to edit Receive IIU Data field
. S DR="5.01 IIU App > Receive IIU Data"
. S DIE="^IBE(365.12,"_+PIEN_",1,"
. S DA=+IENIIU,DA(1)=+PIEN
. D ^DIE S:$D(Y) OPTOUT=1 K DIE,DA,DR
Q
;/vd-IB*2.0*687 - End of new code.
;
PAYER() ; Select Payer - File #365.12
; Init vars
NEW DIC,DTOUT,DUOUT,X,Y
;
W !!
; IB*732/DTG start - change standard DIC call to begins with/contains/list
;S DIC(0)="ABEQ"
;S DIC("A")=$$FO^IBCNEUT1("Payer Name: ",15,"R")
;S DIC="^IBE(365.12,"
;D ^DIC
;I $D(DUOUT)!$D(DTOUT)!(Y<1) S Y=""
; ;
;Q $P(Y,U,1)
;
; Part 1, begin, contains, list
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILTER,IBA,IBB,IBCT,IBD,IBFND,IBI,IBJ,IBK,IBL,IBLKNM,IBLKUNM,IBN,IBNMA
N IBNML,IBNMR,IBR,IBTMPA,IBTMPFIL,IBTN
S IBTMPFIL="^TMP(""IBCNEPY-PALK"","_$J_")"
PAYST ; start of payer questions
K DIR,DIROUT,DIRUT,DTOUT,DUOUT
S FILTER=""
S DIR(0)="SA^B:Begins with;C:Contains;L:List"
S DIR("A")="Select B, C, or L: "
S DIR("A",1)=" B - Payer(s) that Begin with"
S DIR("A",2)=" C - Payer(s) that Contain"
S DIR("A",3)=" L - List of all Payers"
S DIR("A",4)=" "
S DIR("B")="B"
S DIR("?")="^D HLPBEG^IBCNEPY",DIR("??")=DIR("?")
D ^DIR
S Y=$$UP^XLFSTR(Y)
S FILTER="",FILTER=$S($E(Y)="B":1,$E(Y)="C":2,$E(Y)="L":3,1:"")
I Y'=""&('FILTER)&($E(Y)'=U) W " ??" G PAYST
I FILTER'=1&(FILTER'=2)&(FILTER'=3) S IBFND="" G PAYX
I FILTER=3 D PAYLST G PAYST
;
; Part 2, look up payer from 365.12
PAYNAM ;ask name
K DIR,DIROUT,DIRUT,DTOUT,DUOUT
W !
S DIR(0)="FO^1-80"
S DIR("A")="Payer Name"
S DIR("?")="^D HLPPN^IBCNEPY"
S DIR("??")=DIR("?")
D ^DIR
S IBFND=""
I $E(Y)=U!(Y="")!($E(Y)="-") G PAYST
;I Y=""!(Y=-1) G PAYX
S IBLKNM=Y,IBLKUNM=$$UP^XLFSTR(IBLKNM),IBNML=$L(IBLKUNM)
;Part 2A - collect names
K @IBTMPFIL
;S IBFND="",IBNMA="^IBE(365.12,""B""",IBNMR=IBNMA_")"
S @IBTMPFIL@(0)=0,IBOK=0
;F S IBNMR=$Q(@IBNMR) Q:IBNMR=""!($E(IBNMR,1,$L(IBNMA))'=IBNMA) D
S IBFND="",IBNMA="",IBNMR=""
F S IBNMA=$O(^IBE(365.12,"BB",IBNMA)) Q:IBNMA="" D
. S IBNMR="" F S IBNMR=$O(^IBE(365.12,"BB",IBNMA,IBNMR)) Q:'IBNMR D
.. ;S IBA=$QS(IBNMR,3),IBN=$QS(IBNMR,4),IBB=$$UP^XLFSTR(IBA)
.. S IBA=IBNMA,IBB=$$UP^XLFSTR(IBNMA),IBN=IBNMR
.. S IBOK=$$FILTER^IBCNINSU(IBB,FILTER_U_IBLKUNM)
.. I IBOK D PSET
; Part 3 display / select displayed names
I '@IBTMPFIL@(0) S IBFND="" D G PAYNAM ; no payer's found
. W " No payer names matching criteria found"
S IBFND="",IBCT=$G(@IBTMPFIL@(0)),IBR="",IBTN=$FN((IBCT/5),"",1),IBR=+$P(IBTN,".",1)*5,IBTN=$P(IBTN,".",2)
S:IBTN IBR=IBR+5 K IBTMPA
I IBCT=1 S IBFND=$P($G(@IBTMPFIL@(IBCT)),U,2)
I IBFND G PAYX
S IBTN="" I IBCT<6 M IBTMPA=@IBTMPFIL K IBTMPA(0) D G:IBFND=U PAYST G:'IBFND PAYNAM G PAYX
. S IBK=IBCT,IBFND=$$PAYD(.IBTMPA,0,IBK)
S IBK=0
F IBI=0:5:IBR Q:IBFND!(IBFND=U) K IBTMPA F IBJ=1:1:5 S IBK=IBI+IBJ D Q:IBFND!(IBFND=U)!(IBK>IBCT)
. S IBD=$G(@IBTMPFIL@(IBK)),IBFND="" I IBD'="" S IBTMPA(IBK)=IBD
. I IBD=""!(IBJ=5) S IBL=$S(IBK<IBCT:1,IBK=IBCT:0,1:0) D
. . S IBLM=IBK I 'IBL&(IBK>IBCT) S IBLM=IBCT
. . S IBFND=$$PAYD(.IBTMPA,IBL,IBLM)
I IBFND=U G PAYST
I 'IBFND G PAYNAM
G PAYX
PAYX ; payer lookup exit point
K @IBTMPFIL
;END
I IBFND=U S IBFND=""
Q IBFND
;
PSET ;set name into tmp array
N IBC,IBD
S IBC=@IBTMPFIL@(0)+1,@IBTMPFIL@(0)=IBC
S @IBTMPFIL@(IBC)=IBA_U_IBN
Q
;
PAYD(IBARY,IBO,IBLM) ; display up to 5 payer's for selection at a time.
; IBARY - 5 items to display
; IBO - are there more to display
;
I $O(IBARY(0))="" Q ""
N DIR,DIRUT,DIROUT,IBA,IBB,IBD,IBM,X,Y
; array is payer name ^ payer 365.12 ien
S DIR(0)="LCO^1:"_IBLM,IBA=0 F S IBA=$O(IBARY(IBA)) Q:'IBA D
. S IBD=IBARY(IBA)
. ;IB*737/DTG display complete names
. ;S IBM=$E($P(IBD,U,1),1,35)
. S IBM=$P(IBD,U,1)
. W !,?6,IBA,?13,IBM
S DIR("?")="Enter the Item Number for the Payer desired"
S DIR("A")="CHOOSE"
I IBO=1 D
. S DIR("A",1)="Press "_($S(IBO=1:"<Enter> to see more, ",1:""))_"'^' to exit this list, OR"
D ^DIR
I $E(Y)=U S IBFND=U
I Y S IBFND=$P(@IBTMPFIL@(+Y),U,2)
Q IBFND
;
HLPBEG ; display help message
W !,"Select the type of filter to narrow down your list of available Payers:"
W !," Begins with - Displays Payer(s) that begin with the specified text"
W !," Contains - Displays Payer(s) that contain the specified text"
W !," List - Displays listing of all Payers"
Q
;
HLPPN ; display help message for payer name
I FILTER=1 W !,"Enter the Payer's name that you want to Begin With." Q
I FILTER=2 W !,"Enter the string that you want the Payer's name to Contain." Q
W !,"Enter Payer Name"
Q
;
PAYLST ; list out payers in payer 'BB' index in groups of 20
;
N DIR,DTOUT,DUOUT,IBA,IBB,IBC,IBOK,X,Y
W !,"CHOOSE FROM:"
S IBA="",IBC=0
; IB*737/DTG change to use full name cross reference
;F S IBA=$O(^IBE(365.12,"B",IBA)) Q:IBA="" S IBOK=1,IBC=IBC+1 D Q:'IBOK
F S IBA=$O(^IBE(365.12,"BB",IBA)) Q:IBA="" S IBOK=1 D Q:'IBOK
. S IBB="" F S IBB=$O(^IBE(365.12,"BB",IBA,IBB)) Q:IBB="" S IBC=IBC+1 D Q:'IBOK
.. W !,IBA
.. I IBC#20'=0 Q
.. S DIR(0)="E" D ^DIR K DIR
.. I $D(DTOUT)!($D(DUOUT)) S IBOK=0
W !!
Q
;
; IB*732/DTG end - change standard DIC call to begins with/contains/list
HELP1 ;This is the help text for RECEIVE IIU DATA (#365.121,5.01) ICR #: 10142
N ARR
S ARR(1,"F")="!"
S ARR(1)="This field identifies whether the VA facility is allowing Interfacility"
S ARR(2,"F")="!"
S ARR(2)="Insurance Update Data to be received and saved into the buffer for processing."
S ARR(3,"F")="!"
S ARR(3)="Enter '1' for YES, show policies received from IIU for this payer in the buffer."
S ARR(4,"F")="!"
S ARR(4)="Enter '0' for No, don't show policies received from IIU in the buffer."
S ARR(5,"F")="!"
D EN^DDIOL(.ARR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEPY 14813 printed Nov 22, 2024@17:25 Page 2
IBCNEPY ;DAOU/BHS - eIV PAYER EDIT OPTION ;28-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**184,416,668,687,732,737**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;IB*737/TAZ - Remove references to "~NO PAYER"
+5 ;
+6 ; Tag HELP1 calls EN^DDIOL
+7 ; Reference to EN^DDIOL in ICR #10142
+8 ; Call only from a tag
+9 ;
EN ; Main entry point
+1 ; Input: n/a
+2 ; Output: Modifies entries in the Payer File (#365.12)
+3 ;
+4 ; Initialize variables
+5 NEW PYRIEN
+6 ;
+7 DO CLRSCRN
+8 FOR
SET PYRIEN=$$PAYER()
if 'PYRIEN
QUIT
DO EDIT(PYRIEN)
+9 ;
ENX ; EN exit point
+1 QUIT
+2 ;
CLRSCRN ;
+1 WRITE @IOF
+2 WRITE !?35,"Payer Edit"
+3 ;/vd-IB*2*687 - Changed the following informative text.
+4 WRITE !!,"This option displays the data in the Payer file for a given payer. You"
+5 WRITE !,"may only edit site controlled fields and most fields are not site controlled."
+6 WRITE !,"Site controlled fields cannot be edited for a deactivated payer."
+7 QUIT
+8 ;
EDIT(PIEN) ; Modify Payer application settings -/vd-IB*2*687 - Changed the variable IEN to PIEN
+1 ; Input: IEN - key to Payer File (#365.12)
+2 ; Output: Modifies entries in the Payer File
+3 ;
+4 ; Initialize variables
+5 ;NEW IBDATA,LN,APPIEN ;/vd-IB*2*687 - Replaced this line with the following line.
+6 ;IB*732/CKB - added ISBLUE
+7 NEW ARRAYEIV,ARRAYIIU,DEACT,EIVIENS,IBDATA,IENEIV,IENIIU,IIUIENS,ISBLUE,LN,LNLFT,LNRHT
+8 ;
+9 ;S LN=26 ;/vd-IB*2*687 - Replaced this line.
+10 ;/vd-IB*2*687 - Beginning of new code.
+11 SET IENEIV=$$FIND1^DIC(365.13,,,"EIV")
SET IENIIU=$$FIND1^DIC(365.13,,,"IIU")
+12 ;Set LN to center the Payer display
SET LN=40
+13 ; Set LEFT and RIGHT column positions for alignment
SET LNLFT=27
SET LNRHT=37
+14 ;/vd-IB*2*687 - End of new code.
+15 ;
+16 ; Display non-editable fields:
+17 ; Payer Name, VA National ID, CMS National ID, Date/Time Created,
+18 ; EDI ID Number - Prof., EDI ID Number - Inst.
+19 ;/vd-IB*2*687 - Changed the variable IEN to PIEN
SET IBDATA=$GET(^IBE(365.12,+PIEN,0))
+20 ;
+21 DO CLRSCRN
+22 ;IB*737/CKB - allow for large Payer names by centering the Payer Name
+23 NEW PNCTR,PNLEN
+24 SET PNLEN=$LENGTH($PIECE(IBDATA,U,1))
+25 IF PNLEN>73
WRITE !!,"Payer: "_$PIECE(IBDATA,U,1)
+26 IF PNLEN<73
SET PNCTR=(80-(PNLEN+7))/2
WRITE !!,?PNCTR,"Payer: ",$PIECE(IBDATA,U,1),!
+27 WRITE !,$$FO^IBCNEUT1("VA National ID: ",LN,"R"),$PIECE(IBDATA,U,2)
+28 WRITE !,$$FO^IBCNEUT1("CMS National ID: ",LN,"R"),$PIECE(IBDATA,U,3)
+29 ;IB*732/CKB - display Blue Payer indicator if populated with 1-YES
+30 ; NOTE: FSC refers to this field as ISBLUE
+31 IF +$PIECE(IBDATA,U,9)
SET ISBLUE=$PIECE(IBDATA,U,9)
Begin DoDot:1
+32 WRITE !,$$FO^IBCNEUT1("Blue Payer: ",LN,"R"),$SELECT(+ISBLUE:"YES",1:"NO")
End DoDot:1
+33 WRITE !,$$FO^IBCNEUT1("Inst Electronic Bill ID: ",LN,"R"),$PIECE(IBDATA,U,6)
+34 WRITE !,$$FO^IBCNEUT1("Prof Electronic Bill ID: ",LN,"R"),$PIECE(IBDATA,U,5)
+35 WRITE !,$$FO^IBCNEUT1("Date/Time Created: ",LN,"R"),$$FMTE^XLFDT($PIECE(IBDATA,U,4),"5Z")
+36 ;
+37 ;/vd-IB*2.0*687 - Replaced the following commented out lines of code.
+38 ;**************************************************************************
+39 ; Edit only the eIV payer application - IB*2*416
+40 ;IB*668/TAZ - Changed Payer Application from IIV to EIV
+41 ;S APPIEN=+$$PYRAPP^IBCNEUT5("EIV",+IEN)
+42 ;I 'APPIEN D Q
+43 ;. W !!,"There is no eIV payer application defined for this Payer."
+44 ;. W ! S DIR(0)="E" D ^DIR K DIR W !
+45 ;. Q
+46 ;;
+47 ;D APPEDIT(+IEN,+APPIEN) ; +APPIEN is always the eIV payer application
+48 ;Q
+49 ;;
+50 ;APPEDIT(PIEN,AIEN) ; Modify eIV Payer application settings
+51 ;; Input: PIEN - key to Payer File (#365.12),
+52 ;; AIEN - key to Payer Application File (#365.13) - eIV payer application
+53 ;; Output: Modifies entries in the Payer File
+54 ;;
+55 ;; Initialize variables
+56 ;;IB*668/TAZ - Added DEACT to NEW statement
+57 ;NEW DEACT,IBNODE,LN,FDA,DR,DA,DTOUT,DIE,DIRUT,DIR,X,Y
+58 ;;
+59 ;; Determine if the application is already defined for the Payer
+60 ;S LN=35
+61 ;S IBNODE=$G(^IBE(365.12,+PIEN,1,+AIEN,0))
+62 ;W !
+63 ;;
+64 ;I IBNODE="" W !,"eIV Payer Application not found - ERROR!" S DIR(0)="E" D ^DIR K DIR G APPEDX
+65 ;;
+66 ;;IB*668/TAZ - Changed Active to Enabled in field name and display
+67 ;; Display non-editable fields:
+68 ;W !,$$FO^IBCNEUT1("Payer Application: ",LN,"R"),"eIV"
+69 ;W !,$$FO^IBCNEUT1("Nationally Enabled: ",LN,"R"),$S(+$P(IBNODE,U,2):"Enabled",1:"Not Enabled")
+70 ;;IB*668/TAZ - Changed location for Future and Past Service date as well as Auto-Update
+71 ;W !,$$FO^IBCNEUT1("Future Service Days: ",LN,"R"),$$GET1^DIQ(365.121,+AIEN_","_PIEN_",",4.03)
+72 ;W !,$$FO^IBCNEUT1("Past Service Days: ",LN,"R"),$$GET1^DIQ(365.121,+AIEN_","_PIEN_",",4.04)
+73 ;W !,$$FO^IBCNEUT1("Auto-update Pt. Insurance: ",LN,"R"),$$GET1^DIQ(365.121,+AIEN_","_PIEN_",",4.01)
+74 ;;IB*668/TAZ - Changed how Deactivated is determined and changed Active to Enabled
+75 ;; Display deactivation info only when it exists
+76 ;S DEACT=$$PYRDEACT^IBCNINSU(+PIEN)
+77 ;I +DEACT D G APPEDX
+78 ;. W !,$$FO^IBCNEUT1("Deactivated: ",LN,"R"),$S(+DEACT:"YES",1:"NO")
+79 ;. W !,$$FO^IBCNEUT1("Deactivation Date/Time: ",LN,"R"),$S(+$P(DEACT,U,2):$$FMTE^XLFDT($P(DEACT,U,2),"5Z"),1:"")
+80 ;. ; Locally Enabled is non-editable if application is deactivated
+81 ;. W !,$$FO^IBCNEUT1("Locally Enabled: ",LN,"R"),$S(+$P(IBNODE,U,3):"Enabled",1:"Not Enabled")
+82 ;;
+83 ;; Allow user to edit Locally Enabled flag
+84 ;; Also file the user who edited this local flag and the date/time
+85 ;S DR=".03 Locally Enabled;.04////"_$G(DUZ)_";.05////"_$$NOW^XLFDT
+86 ;S DIE="^IBE(365.12,"_+PIEN_",1,"
+87 ;S DA=+AIEN,DA(1)=+PIEN
+88 ;D ^DIE
+89 ;;
+90 ;APPEDX Q
+91 ;/vd-IB*2.0*687 - End of commented out code.
+92 ;**************************************************************************
+93 ;/vd-IB*2.0*687 - Beginning of new code. Moved the Deactivation check and display to here
+94 ; Get Deactivated data.
SET DEACT=$$PYRDEACT^IBCNINSU(+PIEN)
+95 ; If deactivated, display the deactivation information.
IF +DEACT
Begin DoDot:1
+96 WRITE !,$$FO^IBCNEUT1("Deactivated: ",LN,"R"),$SELECT(+DEACT:"YES",1:"NO")
+97 WRITE !,$$FO^IBCNEUT1("Deactivation Date/Time: ",LN,"R"),$SELECT(+$PIECE(DEACT,U,2):$$FMTE^XLFDT($PIECE(DEACT,U,2),"5Z"),1:"")
End DoDot:1
+98 ;
+99 ;/vd-IB*2*687 - Modified the display of applications to handle both eIV and IIU.
+100 ; Get the ien of the EIV application
SET IENEIV=+$$PYRAPP^IBCNEUT5("EIV",+PIEN)
+101 ; Get the ien of the IIU application
SET IENIIU=+$$PYRAPP^IBCNEUT5("IIU",+PIEN)
+102 ;
+103 ; No applications for this Payer.
IF 'IENEIV
IF 'IENIIU
Begin DoDot:1
+104 WRITE !!,"There are no eIV or IIU payer applications defined for this Payer."
+105 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE !
End DoDot:1
QUIT
+106 ;
+107 KILL ARRAYEIV,ARRAYIIU
+108 IF IENEIV
Begin DoDot:1
+109 ; Get the Payer's EIV data.
DO PAYER^IBCNINSU(+PIEN,"EIV","*","E",.ARRAYEIV)
+110 SET EIVIENS=$ORDER(ARRAYEIV(365.121,""))
End DoDot:1
+111 IF IENIIU
Begin DoDot:1
+112 ; Get the Payer's IIU data.
DO PAYER^IBCNINSU(+PIEN,"IIU","*","E",.ARRAYIIU)
+113 SET IIUIENS=$ORDER(ARRAYIIU(365.121,""))
End DoDot:1
+114 ; There's no EIV data to display, so the IIU data displays on the left.
IF 'IENEIV
SET LNRHT=LNLFT
+115 ;
+116 ; Display the Application(s) data.
DO APPDSPLY
+117 ; Do not attempt to Edit the editable fields if Deactivated.
IF +DEACT
QUIT
+118 ; Edit the Application Fields that are editable.
DO APPEDIT
+119 QUIT
+120 ;
APPDSPLY ; Display Application Data
+1 NEW DASHES,OFFSET
+2 SET $PIECE(DASHES,"-",80)="-"
+3 WRITE !!,$$FO^IBCNEUT1("Payer Application: ",LNLFT,"R"),$SELECT(+IENEIV:"eIV",1:"IIU")
+4 IF +IENEIV
IF +IENIIU
SET OFFSET=4
WRITE $$FO^IBCNEUT1("Payer Application: ",(LNRHT-OFFSET),"R"),"IIU"
+5 ;
+6 WRITE !,$EXTRACT(DASHES,1,38)
IF +IENEIV
IF +IENIIU
WRITE ?40,$EXTRACT(DASHES,1,35)
+7 WRITE !
+8 SET OFFSET=0
+9 IF +IENEIV
Begin DoDot:1
+10 WRITE $$FO^IBCNEUT1("Nationally Enabled: ",LNLFT,"R")
+11 WRITE $GET(ARRAYEIV(365.121,EIVIENS,.02,"E"))
+12 SET OFFSET=$LENGTH($GET(ARRAYEIV(365.121,EIVIENS,.02,"E")))+1
End DoDot:1
+13 IF +IENIIU
Begin DoDot:1
+14 WRITE $$FO^IBCNEUT1("Nationally Enabled: ",(LNRHT-OFFSET),"R")
+15 WRITE $GET(ARRAYIIU(365.121,IIUIENS,.02,"E"))
End DoDot:1
+16 ;
+17 WRITE !
+18 SET OFFSET=0
+19 IF +IENEIV
Begin DoDot:1
+20 WRITE $$FO^IBCNEUT1("Future Service Days: ",LNLFT,"R")
+21 WRITE $GET(ARRAYEIV(365.121,EIVIENS,4.03,"E"))
+22 SET OFFSET=$LENGTH($GET(ARRAYEIV(365.121,EIVIENS,4.03,"E")))+1
End DoDot:1
+23 IF +IENIIU
Begin DoDot:1
+24 WRITE $$FO^IBCNEUT1("IIU Locally Enabled: ",(LNRHT-OFFSET),"R")
+25 WRITE $GET(ARRAYIIU(365.121,IIUIENS,.03,"E"))
End DoDot:1
+26 ;
+27 WRITE !
+28 SET OFFSET=0
+29 IF +IENEIV
Begin DoDot:1
+30 WRITE $$FO^IBCNEUT1("Past Service Days: ",LNLFT,"R")
+31 WRITE $GET(ARRAYEIV(365.121,EIVIENS,4.04,"E"))
+32 SET OFFSET=$LENGTH($GET(ARRAYEIV(365.121,EIVIENS,4.04,"E")))+1
End DoDot:1
+33 IF +IENIIU
Begin DoDot:1
+34 WRITE $$FO^IBCNEUT1("Receive IIU Data: ",(LNRHT-OFFSET),"R")
+35 WRITE $GET(ARRAYIIU(365.121,IIUIENS,5.01,"E"))
End DoDot:1
+36 ;
+37 IF +IENEIV
Begin DoDot:1
+38 WRITE !,$$FO^IBCNEUT1("Auto-update Pt. Insurance: ",LNLFT,"R")
+39 WRITE $GET(ARRAYEIV(365.121,EIVIENS,4.01,"E"))
+40 WRITE !,$$FO^IBCNEUT1("eIV Locally Enabled: ",LNLFT,"R")
+41 WRITE $GET(ARRAYEIV(365.121,EIVIENS,.03,"E"))
End DoDot:1
+42 ;
+43 WRITE !
+44 QUIT
+45 ;
+46 ;/vd-IB*2*687 - Modified APPEDIT for Editable fields for eIV and IIU applications.
APPEDIT ; Edit the Payer Application fields that are editable.
+1 NEW FDA,DR,DA,DTOUT,DIE,DIRUT,DIR,OPTOUT,X,Y
+2 SET OPTOUT=0
+3 ; Allow user to edit eIV Locally Enabled flag
IF +IENEIV
Begin DoDot:1
+4 SET DR=".03 eIV App > eIV Locally Enabled"
+5 SET DR=DR_";.04////"_$GET(DUZ)_";.05////"_$$NOW^XLFDT
+6 SET DIE="^IBE(365.12,"_+PIEN_",1,"
+7 SET DA=+IENEIV
SET DA(1)=+PIEN
+8 DO ^DIE
if $DATA(Y)
SET OPTOUT=1
KILL DIE,DA,DR
End DoDot:1
if OPTOUT
QUIT
+9 ;
+10 ; Allow user to edit Receive IIU Data field
IF +IENIIU
Begin DoDot:1
+11 SET DR="5.01 IIU App > Receive IIU Data"
+12 SET DIE="^IBE(365.12,"_+PIEN_",1,"
+13 SET DA=+IENIIU
SET DA(1)=+PIEN
+14 DO ^DIE
if $DATA(Y)
SET OPTOUT=1
KILL DIE,DA,DR
End DoDot:1
+15 QUIT
+16 ;/vd-IB*2.0*687 - End of new code.
+17 ;
PAYER() ; Select Payer - File #365.12
+1 ; Init vars
+2 NEW DIC,DTOUT,DUOUT,X,Y
+3 ;
+4 WRITE !!
+5 ; IB*732/DTG start - change standard DIC call to begins with/contains/list
+6 ;S DIC(0)="ABEQ"
+7 ;S DIC("A")=$$FO^IBCNEUT1("Payer Name: ",15,"R")
+8 ;S DIC="^IBE(365.12,"
+9 ;D ^DIC
+10 ;I $D(DUOUT)!$D(DTOUT)!(Y<1) S Y=""
+11 ; ;
+12 ;Q $P(Y,U,1)
+13 ;
+14 ; Part 1, begin, contains, list
+15 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILTER,IBA,IBB,IBCT,IBD,IBFND,IBI,IBJ,IBK,IBL,IBLKNM,IBLKUNM,IBN,IBNMA
+16 NEW IBNML,IBNMR,IBR,IBTMPA,IBTMPFIL,IBTN
+17 SET IBTMPFIL="^TMP(""IBCNEPY-PALK"","_$JOB_")"
PAYST ; start of payer questions
+1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+2 SET FILTER=""
+3 SET DIR(0)="SA^B:Begins with;C:Contains;L:List"
+4 SET DIR("A")="Select B, C, or L: "
+5 SET DIR("A",1)=" B - Payer(s) that Begin with"
+6 SET DIR("A",2)=" C - Payer(s) that Contain"
+7 SET DIR("A",3)=" L - List of all Payers"
+8 SET DIR("A",4)=" "
+9 SET DIR("B")="B"
+10 SET DIR("?")="^D HLPBEG^IBCNEPY"
SET DIR("??")=DIR("?")
+11 DO ^DIR
+12 SET Y=$$UP^XLFSTR(Y)
+13 SET FILTER=""
SET FILTER=$SELECT($EXTRACT(Y)="B":1,$EXTRACT(Y)="C":2,$EXTRACT(Y)="L":3,1:"")
+14 IF Y'=""&('FILTER)&($EXTRACT(Y)'=U)
WRITE " ??"
GOTO PAYST
+15 IF FILTER'=1&(FILTER'=2)&(FILTER'=3)
SET IBFND=""
GOTO PAYX
+16 IF FILTER=3
DO PAYLST
GOTO PAYST
+17 ;
+18 ; Part 2, look up payer from 365.12
PAYNAM ;ask name
+1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+2 WRITE !
+3 SET DIR(0)="FO^1-80"
+4 SET DIR("A")="Payer Name"
+5 SET DIR("?")="^D HLPPN^IBCNEPY"
+6 SET DIR("??")=DIR("?")
+7 DO ^DIR
+8 SET IBFND=""
+9 IF $EXTRACT(Y)=U!(Y="")!($EXTRACT(Y)="-")
GOTO PAYST
+10 ;I Y=""!(Y=-1) G PAYX
+11 SET IBLKNM=Y
SET IBLKUNM=$$UP^XLFSTR(IBLKNM)
SET IBNML=$LENGTH(IBLKUNM)
+12 ;Part 2A - collect names
+13 KILL @IBTMPFIL
+14 ;S IBFND="",IBNMA="^IBE(365.12,""B""",IBNMR=IBNMA_")"
+15 SET @IBTMPFIL@(0)=0
SET IBOK=0
+16 ;F S IBNMR=$Q(@IBNMR) Q:IBNMR=""!($E(IBNMR,1,$L(IBNMA))'=IBNMA) D
+17 SET IBFND=""
SET IBNMA=""
SET IBNMR=""
+18 FOR
SET IBNMA=$ORDER(^IBE(365.12,"BB",IBNMA))
if IBNMA=""
QUIT
Begin DoDot:1
+19 SET IBNMR=""
FOR
SET IBNMR=$ORDER(^IBE(365.12,"BB",IBNMA,IBNMR))
if 'IBNMR
QUIT
Begin DoDot:2
+20 ;S IBA=$QS(IBNMR,3),IBN=$QS(IBNMR,4),IBB=$$UP^XLFSTR(IBA)
+21 SET IBA=IBNMA
SET IBB=$$UP^XLFSTR(IBNMA)
SET IBN=IBNMR
+22 SET IBOK=$$FILTER^IBCNINSU(IBB,FILTER_U_IBLKUNM)
+23 IF IBOK
DO PSET
End DoDot:2
End DoDot:1
+24 ; Part 3 display / select displayed names
+25 ; no payer's found
IF '@IBTMPFIL@(0)
SET IBFND=""
Begin DoDot:1
+26 WRITE " No payer names matching criteria found"
End DoDot:1
GOTO PAYNAM
+27 SET IBFND=""
SET IBCT=$GET(@IBTMPFIL@(0))
SET IBR=""
SET IBTN=$FNUMBER((IBCT/5),"",1)
SET IBR=+$PIECE(IBTN,".",1)*5
SET IBTN=$PIECE(IBTN,".",2)
+28 if IBTN
SET IBR=IBR+5
KILL IBTMPA
+29 IF IBCT=1
SET IBFND=$PIECE($GET(@IBTMPFIL@(IBCT)),U,2)
+30 IF IBFND
GOTO PAYX
+31 SET IBTN=""
IF IBCT<6
MERGE IBTMPA=@IBTMPFIL
KILL IBTMPA(0)
Begin DoDot:1
+32 SET IBK=IBCT
SET IBFND=$$PAYD(.IBTMPA,0,IBK)
End DoDot:1
if IBFND=U
GOTO PAYST
if 'IBFND
GOTO PAYNAM
GOTO PAYX
+33 SET IBK=0
+34 FOR IBI=0:5:IBR
if IBFND!(IBFND=U)
QUIT
KILL IBTMPA
FOR IBJ=1:1:5
SET IBK=IBI+IBJ
Begin DoDot:1
+35 SET IBD=$GET(@IBTMPFIL@(IBK))
SET IBFND=""
IF IBD'=""
SET IBTMPA(IBK)=IBD
+36 IF IBD=""!(IBJ=5)
SET IBL=$SELECT(IBK<IBCT:1,IBK=IBCT:0,1:0)
Begin DoDot:2
+37 SET IBLM=IBK
IF 'IBL&(IBK>IBCT)
SET IBLM=IBCT
+38 SET IBFND=$$PAYD(.IBTMPA,IBL,IBLM)
End DoDot:2
End DoDot:1
if IBFND!(IBFND=U)!(IBK>IBCT)
QUIT
+39 IF IBFND=U
GOTO PAYST
+40 IF 'IBFND
GOTO PAYNAM
+41 GOTO PAYX
PAYX ; payer lookup exit point
+1 KILL @IBTMPFIL
+2 ;END
+3 IF IBFND=U
SET IBFND=""
+4 QUIT IBFND
+5 ;
PSET ;set name into tmp array
+1 NEW IBC,IBD
+2 SET IBC=@IBTMPFIL@(0)+1
SET @IBTMPFIL@(0)=IBC
+3 SET @IBTMPFIL@(IBC)=IBA_U_IBN
+4 QUIT
+5 ;
PAYD(IBARY,IBO,IBLM) ; display up to 5 payer's for selection at a time.
+1 ; IBARY - 5 items to display
+2 ; IBO - are there more to display
+3 ;
+4 IF $ORDER(IBARY(0))=""
QUIT ""
+5 NEW DIR,DIRUT,DIROUT,IBA,IBB,IBD,IBM,X,Y
+6 ; array is payer name ^ payer 365.12 ien
+7 SET DIR(0)="LCO^1:"_IBLM
SET IBA=0
FOR
SET IBA=$ORDER(IBARY(IBA))
if 'IBA
QUIT
Begin DoDot:1
+8 SET IBD=IBARY(IBA)
+9 ;IB*737/DTG display complete names
+10 ;S IBM=$E($P(IBD,U,1),1,35)
+11 SET IBM=$PIECE(IBD,U,1)
+12 WRITE !,?6,IBA,?13,IBM
End DoDot:1
+13 SET DIR("?")="Enter the Item Number for the Payer desired"
+14 SET DIR("A")="CHOOSE"
+15 IF IBO=1
Begin DoDot:1
+16 SET DIR("A",1)="Press "_($SELECT(IBO=1:"<Enter> to see more, ",1:""))_"'^' to exit this list, OR"
End DoDot:1
+17 DO ^DIR
+18 IF $EXTRACT(Y)=U
SET IBFND=U
+19 IF Y
SET IBFND=$PIECE(@IBTMPFIL@(+Y),U,2)
+20 QUIT IBFND
+21 ;
HLPBEG ; display help message
+1 WRITE !,"Select the type of filter to narrow down your list of available Payers:"
+2 WRITE !," Begins with - Displays Payer(s) that begin with the specified text"
+3 WRITE !," Contains - Displays Payer(s) that contain the specified text"
+4 WRITE !," List - Displays listing of all Payers"
+5 QUIT
+6 ;
HLPPN ; display help message for payer name
+1 IF FILTER=1
WRITE !,"Enter the Payer's name that you want to Begin With."
QUIT
+2 IF FILTER=2
WRITE !,"Enter the string that you want the Payer's name to Contain."
QUIT
+3 WRITE !,"Enter Payer Name"
+4 QUIT
+5 ;
PAYLST ; list out payers in payer 'BB' index in groups of 20
+1 ;
+2 NEW DIR,DTOUT,DUOUT,IBA,IBB,IBC,IBOK,X,Y
+3 WRITE !,"CHOOSE FROM:"
+4 SET IBA=""
SET IBC=0
+5 ; IB*737/DTG change to use full name cross reference
+6 ;F S IBA=$O(^IBE(365.12,"B",IBA)) Q:IBA="" S IBOK=1,IBC=IBC+1 D Q:'IBOK
+7 FOR
SET IBA=$ORDER(^IBE(365.12,"BB",IBA))
if IBA=""
QUIT
SET IBOK=1
Begin DoDot:1
+8 SET IBB=""
FOR
SET IBB=$ORDER(^IBE(365.12,"BB",IBA,IBB))
if IBB=""
QUIT
SET IBC=IBC+1
Begin DoDot:2
+9 WRITE !,IBA
+10 IF IBC#20'=0
QUIT
+11 SET DIR(0)="E"
DO ^DIR
KILL DIR
+12 IF $DATA(DTOUT)!($DATA(DUOUT))
SET IBOK=0
End DoDot:2
if 'IBOK
QUIT
End DoDot:1
if 'IBOK
QUIT
+13 WRITE !!
+14 QUIT
+15 ;
+16 ; IB*732/DTG end - change standard DIC call to begins with/contains/list
HELP1 ;This is the help text for RECEIVE IIU DATA (#365.121,5.01) ICR #: 10142
+1 NEW ARR
+2 SET ARR(1,"F")="!"
+3 SET ARR(1)="This field identifies whether the VA facility is allowing Interfacility"
+4 SET ARR(2,"F")="!"
+5 SET ARR(2)="Insurance Update Data to be received and saved into the buffer for processing."
+6 SET ARR(3,"F")="!"
+7 SET ARR(3)="Enter '1' for YES, show policies received from IIU for this payer in the buffer."
+8 SET ARR(4,"F")="!"
+9 SET ARR(4)="Enter '0' for No, don't show policies received from IIU in the buffer."
+10 SET ARR(5,"F")="!"
+11 DO EN^DDIOL(.ARR)
+12 QUIT
