Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNEPY

IBCNEPY.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;IB*737/TAZ - Remove references to "~NO PAYER"
  1.  ;
  1.  ; Tag HELP1 calls EN^DDIOL
  1.  ; Reference to EN^DDIOL in ICR #10142
  1.  ; Call only from a tag
  1.  ;
  1. EN ; Main entry point
  1.  ; Input:  n/a
  1.  ; Output: Modifies entries in the Payer File (#365.12)
  1.  ;
  1.  ; Initialize variables
  1.  NEW PYRIEN
  1.  ;
  1.  D CLRSCRN
  1.  F  S PYRIEN=$$PAYER() Q:'PYRIEN  D EDIT(PYRIEN)
  1.  ;
  1. ENX ; EN exit point
  1.  Q
  1.  ;
  1. CLRSCRN ;
  1.  W @IOF
  1.  W !?35,"Payer Edit"
  1.  ;/vd-IB*2*687 - Changed the following informative text.
  1.  W !!,"This option displays the data in the Payer file for a given payer. You"
  1.  W !,"may only edit site controlled fields and most fields are not site controlled."
  1.  W !,"Site controlled fields cannot be edited for a deactivated payer."
  1.  Q
  1.  ;
  1. 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)
  1.  ; Output: Modifies entries in the Payer File
  1.  ;
  1.  ; Initialize variables
  1.  ;NEW IBDATA,LN,APPIEN   ;/vd-IB*2*687 - Replaced this line with the following line.
  1.  ;IB*732/CKB - added ISBLUE
  1.  N ARRAYEIV,ARRAYIIU,DEACT,EIVIENS,IBDATA,IENEIV,IENIIU,IIUIENS,ISBLUE,LN,LNLFT,LNRHT
  1.  ;
  1.  ;S LN=26   ;/vd-IB*2*687 - Replaced this line.
  1.  ;/vd-IB*2*687 - Beginning of new code.
  1.  S IENEIV=$$FIND1^DIC(365.13,,,"EIV"),IENIIU=$$FIND1^DIC(365.13,,,"IIU")
  1.  S LN=40   ;Set LN to center the Payer display
  1.  S LNLFT=27,LNRHT=37 ; Set LEFT and RIGHT column positions for alignment
  1.  ;/vd-IB*2*687 - End of new code.
  1.  ;
  1.  ; Display non-editable fields:
  1.  ;  Payer Name, VA National ID, CMS National ID, Date/Time Created,
  1.  ;  EDI ID Number - Prof., EDI ID Number - Inst.
  1.  S IBDATA=$G(^IBE(365.12,+PIEN,0))    ;/vd-IB*2*687 - Changed the variable IEN to PIEN
  1.  ;
  1.  D CLRSCRN
  1.  ;IB*737/CKB - allow for large Payer names by centering the Payer Name
  1.  N PNCTR,PNLEN
  1.  S PNLEN=$L($P(IBDATA,U,1))
  1.  I PNLEN>73 W !!,"Payer: "_$P(IBDATA,U,1)
  1.  I PNLEN<73 S PNCTR=(80-(PNLEN+7))/2 W !!,?PNCTR,"Payer: ",$P(IBDATA,U,1),!
  1.  W !,$$FO^IBCNEUT1("VA National ID: ",LN,"R"),$P(IBDATA,U,2)
  1.  W !,$$FO^IBCNEUT1("CMS National ID: ",LN,"R"),$P(IBDATA,U,3)
  1.  ;IB*732/CKB - display Blue Payer indicator if populated with 1-YES
  1.  ; NOTE: FSC refers to this field as ISBLUE
  1.  I +$P(IBDATA,U,9) S ISBLUE=$P(IBDATA,U,9) D
  1.  . W !,$$FO^IBCNEUT1("Blue Payer: ",LN,"R"),$S(+ISBLUE:"YES",1:"NO")
  1.  W !,$$FO^IBCNEUT1("Inst Electronic Bill ID: ",LN,"R"),$P(IBDATA,U,6)
  1.  W !,$$FO^IBCNEUT1("Prof Electronic Bill ID: ",LN,"R"),$P(IBDATA,U,5)
  1.  W !,$$FO^IBCNEUT1("Date/Time Created: ",LN,"R"),$$FMTE^XLFDT($P(IBDATA,U,4),"5Z")
  1.  ;
  1.  ;/vd-IB*2.0*687 - Replaced the following commented out lines of code.
  1.  ;**************************************************************************
  1.  ; Edit only the eIV payer application - IB*2*416
  1.  ;IB*668/TAZ - Changed Payer Application from IIV to EIV
  1.  ;S APPIEN=+$$PYRAPP^IBCNEUT5("EIV",+IEN)
  1.  ;I 'APPIEN D  Q
  1.  ;. W !!,"There is no eIV payer application defined for this Payer."
  1.  ;. W ! S DIR(0)="E" D ^DIR K DIR W !
  1.  ;. Q
  1.  ;;
  1.  ;D APPEDIT(+IEN,+APPIEN)       ; +APPIEN is always the eIV payer application
  1.  ;Q
  1.  ;;
  1.  ;APPEDIT(PIEN,AIEN) ; Modify eIV Payer application settings
  1.  ;; Input:  PIEN - key to Payer File (#365.12),
  1.  ;;         AIEN - key to Payer Application File (#365.13) - eIV payer application
  1.  ;; Output: Modifies entries in the Payer File
  1.  ;;
  1.  ;; Initialize variables
  1.  ;;IB*668/TAZ - Added DEACT to NEW statement
  1.  ;NEW DEACT,IBNODE,LN,FDA,DR,DA,DTOUT,DIE,DIRUT,DIR,X,Y
  1.  ;;
  1.  ;; Determine if the application is already defined for the Payer
  1.  ;S LN=35
  1.  ;S IBNODE=$G(^IBE(365.12,+PIEN,1,+AIEN,0))
  1.  ;W !
  1.  ;;
  1.  ;I IBNODE="" W !,"eIV Payer Application not found - ERROR!" S DIR(0)="E" D ^DIR K DIR G APPEDX
  1.  ;;
  1.  ;;IB*668/TAZ - Changed Active to Enabled in field name and display
  1.  ;; Display non-editable fields:
  1.  ;W !,$$FO^IBCNEUT1("Payer Application: ",LN,"R"),"eIV"
  1.  ;W !,$$FO^IBCNEUT1("Nationally Enabled: ",LN,"R"),$S(+$P(IBNODE,U,2):"Enabled",1:"Not Enabled")
  1.  ;;IB*668/TAZ - Changed location for Future and Past Service date as well as Auto-Update
  1.  ;W !,$$FO^IBCNEUT1("Future Service Days: ",LN,"R"),$$GET1^DIQ(365.121,+AIEN_","_PIEN_",",4.03)
  1.  ;W !,$$FO^IBCNEUT1("Past Service Days: ",LN,"R"),$$GET1^DIQ(365.121,+AIEN_","_PIEN_",",4.04)
  1.  ;W !,$$FO^IBCNEUT1("Auto-update Pt. Insurance: ",LN,"R"),$$GET1^DIQ(365.121,+AIEN_","_PIEN_",",4.01)
  1.  ;;IB*668/TAZ - Changed how Deactivated is determined and changed Active to Enabled
  1.  ;; Display deactivation info only when it exists
  1.  ;S DEACT=$$PYRDEACT^IBCNINSU(+PIEN)
  1.  ;I +DEACT D  G APPEDX
  1.  ;. W !,$$FO^IBCNEUT1("Deactivated: ",LN,"R"),$S(+DEACT:"YES",1:"NO")
  1.  ;. W !,$$FO^IBCNEUT1("Deactivation Date/Time: ",LN,"R"),$S(+$P(DEACT,U,2):$$FMTE^XLFDT($P(DEACT,U,2),"5Z"),1:"")
  1.  ;. ; Locally Enabled is non-editable if application is deactivated
  1.  ;. W !,$$FO^IBCNEUT1("Locally Enabled: ",LN,"R"),$S(+$P(IBNODE,U,3):"Enabled",1:"Not Enabled")
  1.  ;;
  1.  ;; Allow user to edit Locally Enabled flag
  1.  ;; Also file the user who edited this local flag and the date/time
  1.  ;S DR=".03                  Locally Enabled;.04////"_$G(DUZ)_";.05////"_$$NOW^XLFDT
  1.  ;S DIE="^IBE(365.12,"_+PIEN_",1,"
  1.  ;S DA=+AIEN,DA(1)=+PIEN
  1.  ;D ^DIE
  1.  ;;
  1.  ;APPEDX Q
  1.  ;/vd-IB*2.0*687 - End of commented out code.
  1.  ;**************************************************************************
  1.  ;/vd-IB*2.0*687 - Beginning of new code. Moved the Deactivation check and display to here
  1.  S DEACT=$$PYRDEACT^IBCNINSU(+PIEN)  ; Get Deactivated data.
  1.  I +DEACT D     ; If deactivated, display the deactivation information.
  1.  . W !,$$FO^IBCNEUT1("Deactivated: ",LN,"R"),$S(+DEACT:"YES",1:"NO")
  1.  . W !,$$FO^IBCNEUT1("Deactivation Date/Time: ",LN,"R"),$S(+$P(DEACT,U,2):$$FMTE^XLFDT($P(DEACT,U,2),"5Z"),1:"")
  1.  ;
  1.  ;/vd-IB*2*687 - Modified the display of applications to handle both eIV and IIU.
  1.  S IENEIV=+$$PYRAPP^IBCNEUT5("EIV",+PIEN)  ; Get the ien of the EIV application
  1.  S IENIIU=+$$PYRAPP^IBCNEUT5("IIU",+PIEN)  ; Get the ien of the IIU application
  1.  ;
  1.  I 'IENEIV,'IENIIU D  Q  ; No applications for this Payer.
  1.  . W !!,"There are no eIV or IIU payer applications defined for this Payer."
  1.  . W ! S DIR(0)="E" D ^DIR K DIR W !
  1.  ;
  1.  K ARRAYEIV,ARRAYIIU
  1.  I IENEIV D
  1.  . D PAYER^IBCNINSU(+PIEN,"EIV","*","E",.ARRAYEIV)   ; Get the Payer's EIV data.
  1.  . S EIVIENS=$O(ARRAYEIV(365.121,""))
  1.  I IENIIU D
  1.  . D PAYER^IBCNINSU(+PIEN,"IIU","*","E",.ARRAYIIU)   ; Get the Payer's IIU data.
  1.  . S IIUIENS=$O(ARRAYIIU(365.121,""))
  1.  I 'IENEIV S LNRHT=LNLFT ; There's no EIV data to display, so the IIU data displays on the left.
  1.  ;
  1.  D APPDSPLY    ; Display the Application(s) data.
  1.  I +DEACT Q    ; Do not attempt to Edit the editable fields if Deactivated.
  1.  D APPEDIT     ; Edit the Application Fields that are editable.
  1.  Q
  1.  ;
  1. APPDSPLY ; Display Application Data
  1.  N DASHES,OFFSET
  1.  S $P(DASHES,"-",80)="-"
  1.  W !!,$$FO^IBCNEUT1("Payer Application: ",LNLFT,"R"),$S(+IENEIV:"eIV",1:"IIU")
  1.  I +IENEIV,+IENIIU S OFFSET=4 W $$FO^IBCNEUT1("Payer Application: ",(LNRHT-OFFSET),"R"),"IIU"
  1.  ;
  1.  W !,$E(DASHES,1,38) I +IENEIV,+IENIIU W ?40,$E(DASHES,1,35)
  1.  W !
  1.  S OFFSET=0
  1.  I +IENEIV D
  1.  . W $$FO^IBCNEUT1("Nationally Enabled: ",LNLFT,"R")
  1.  . W $G(ARRAYEIV(365.121,EIVIENS,.02,"E"))
  1.  . S OFFSET=$L($G(ARRAYEIV(365.121,EIVIENS,.02,"E")))+1
  1.  I +IENIIU D
  1.  . W $$FO^IBCNEUT1("Nationally Enabled: ",(LNRHT-OFFSET),"R")
  1.  . W $G(ARRAYIIU(365.121,IIUIENS,.02,"E"))
  1.  ;
  1.  W !
  1.  S OFFSET=0
  1.  I +IENEIV D
  1.  . W $$FO^IBCNEUT1("Future Service Days: ",LNLFT,"R")
  1.  . W $G(ARRAYEIV(365.121,EIVIENS,4.03,"E"))
  1.  . S OFFSET=$L($G(ARRAYEIV(365.121,EIVIENS,4.03,"E")))+1
  1.  I +IENIIU D
  1.  . W $$FO^IBCNEUT1("IIU Locally Enabled: ",(LNRHT-OFFSET),"R")
  1.  . W $G(ARRAYIIU(365.121,IIUIENS,.03,"E"))
  1.  ;
  1.  W !
  1.  S OFFSET=0
  1.  I +IENEIV D
  1.  . W $$FO^IBCNEUT1("Past Service Days: ",LNLFT,"R")
  1.  . W $G(ARRAYEIV(365.121,EIVIENS,4.04,"E"))
  1.  . S OFFSET=$L($G(ARRAYEIV(365.121,EIVIENS,4.04,"E")))+1
  1.  I +IENIIU D
  1.  . W $$FO^IBCNEUT1("Receive IIU Data: ",(LNRHT-OFFSET),"R")
  1.  . W $G(ARRAYIIU(365.121,IIUIENS,5.01,"E"))
  1.  ;
  1.  I +IENEIV D
  1.  . W !,$$FO^IBCNEUT1("Auto-update Pt. Insurance: ",LNLFT,"R")
  1.  . W $G(ARRAYEIV(365.121,EIVIENS,4.01,"E"))
  1.  . W !,$$FO^IBCNEUT1("eIV Locally Enabled: ",LNLFT,"R")
  1.  . W $G(ARRAYEIV(365.121,EIVIENS,.03,"E"))
  1.  ;
  1.  W !
  1.  Q
  1.  ;
  1.  ;/vd-IB*2*687 - Modified APPEDIT for Editable fields for eIV and IIU applications.
  1. APPEDIT ; Edit the Payer Application fields that are editable.
  1.  N FDA,DR,DA,DTOUT,DIE,DIRUT,DIR,OPTOUT,X,Y
  1.  S OPTOUT=0
  1.  I +IENEIV D  Q:OPTOUT    ; Allow user to edit eIV Locally Enabled flag
  1.  . S DR=".03 eIV App > eIV Locally Enabled"
  1.  . S DR=DR_";.04////"_$G(DUZ)_";.05////"_$$NOW^XLFDT
  1.  . S DIE="^IBE(365.12,"_+PIEN_",1,"
  1.  . S DA=+IENEIV,DA(1)=+PIEN
  1.  . D ^DIE S:$D(Y) OPTOUT=1 K DIE,DA,DR
  1.  ;
  1.  I +IENIIU D    ; Allow user to edit Receive IIU Data field
  1.  . S DR="5.01 IIU App > Receive IIU Data"
  1.  . S DIE="^IBE(365.12,"_+PIEN_",1,"
  1.  . S DA=+IENIIU,DA(1)=+PIEN
  1.  . D ^DIE S:$D(Y) OPTOUT=1 K DIE,DA,DR
  1.  Q
  1.  ;/vd-IB*2.0*687 - End of new code.
  1.  ;
  1. PAYER() ; Select Payer - File #365.12
  1.  ; Init vars
  1.  NEW DIC,DTOUT,DUOUT,X,Y
  1.  ;
  1.  W !!
  1.  ; IB*732/DTG start - change standard DIC call to begins with/contains/list
  1.  ;S DIC(0)="ABEQ"
  1.  ;S DIC("A")=$$FO^IBCNEUT1("Payer Name: ",15,"R")
  1.  ;S DIC="^IBE(365.12,"
  1.  ;D ^DIC
  1.  ;I $D(DUOUT)!$D(DTOUT)!(Y<1) S Y=""
  1.  ; ;
  1.  ;Q $P(Y,U,1)
  1.  ;
  1.  ; Part 1, begin, contains, list
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILTER,IBA,IBB,IBCT,IBD,IBFND,IBI,IBJ,IBK,IBL,IBLKNM,IBLKUNM,IBN,IBNMA
  1.  N IBNML,IBNMR,IBR,IBTMPA,IBTMPFIL,IBTN
  1.  S IBTMPFIL="^TMP(""IBCNEPY-PALK"","_$J_")"
  1. PAYST ; start of payer questions
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  S FILTER=""
  1.  S DIR(0)="SA^B:Begins with;C:Contains;L:List"
  1.  S DIR("A")="Select B, C, or L:  "
  1.  S DIR("A",1)=" B - Payer(s) that Begin with"
  1.  S DIR("A",2)=" C - Payer(s) that Contain"
  1.  S DIR("A",3)=" L - List of all Payers"
  1.  S DIR("A",4)="  "
  1.  S DIR("B")="B"
  1.  S DIR("?")="^D HLPBEG^IBCNEPY",DIR("??")=DIR("?")
  1.  D ^DIR
  1.  S Y=$$UP^XLFSTR(Y)
  1.  S FILTER="",FILTER=$S($E(Y)="B":1,$E(Y)="C":2,$E(Y)="L":3,1:"")
  1.  I Y'=""&('FILTER)&($E(Y)'=U) W "   ??" G PAYST
  1.  I FILTER'=1&(FILTER'=2)&(FILTER'=3) S IBFND="" G PAYX
  1.  I FILTER=3 D PAYLST G PAYST
  1.  ;
  1.  ; Part 2, look up payer from 365.12
  1. PAYNAM ;ask name
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  W !
  1.  S DIR(0)="FO^1-80"
  1.  S DIR("A")="Payer Name"
  1.  S DIR("?")="^D HLPPN^IBCNEPY"
  1.  S DIR("??")=DIR("?")
  1.  D ^DIR
  1.  S IBFND=""
  1.  I $E(Y)=U!(Y="")!($E(Y)="-") G PAYST
  1.  ;I Y=""!(Y=-1) G PAYX
  1.  S IBLKNM=Y,IBLKUNM=$$UP^XLFSTR(IBLKNM),IBNML=$L(IBLKUNM)
  1.  ;Part 2A - collect names
  1.  K @IBTMPFIL
  1.  ;S IBFND="",IBNMA="^IBE(365.12,""B""",IBNMR=IBNMA_")"
  1.  S @IBTMPFIL@(0)=0,IBOK=0
  1.  ;F  S IBNMR=$Q(@IBNMR) Q:IBNMR=""!($E(IBNMR,1,$L(IBNMA))'=IBNMA)  D
  1.  S IBFND="",IBNMA="",IBNMR=""
  1.  F  S IBNMA=$O(^IBE(365.12,"BB",IBNMA)) Q:IBNMA=""  D
  1.  . S IBNMR="" F  S IBNMR=$O(^IBE(365.12,"BB",IBNMA,IBNMR)) Q:'IBNMR  D
  1.  .. ;S IBA=$QS(IBNMR,3),IBN=$QS(IBNMR,4),IBB=$$UP^XLFSTR(IBA)
  1.  .. S IBA=IBNMA,IBB=$$UP^XLFSTR(IBNMA),IBN=IBNMR
  1.  .. S IBOK=$$FILTER^IBCNINSU(IBB,FILTER_U_IBLKUNM)
  1.  .. I IBOK D PSET
  1.  ; Part 3 display / select displayed names
  1.  I '@IBTMPFIL@(0) S IBFND="" D  G PAYNAM ; no payer's found
  1.  . W "   No payer names matching criteria found"
  1.  S IBFND="",IBCT=$G(@IBTMPFIL@(0)),IBR="",IBTN=$FN((IBCT/5),"",1),IBR=+$P(IBTN,".",1)*5,IBTN=$P(IBTN,".",2)
  1.  S:IBTN IBR=IBR+5 K IBTMPA
  1.  I IBCT=1 S IBFND=$P($G(@IBTMPFIL@(IBCT)),U,2)
  1.  I IBFND G PAYX
  1.  S IBTN="" I IBCT<6 M IBTMPA=@IBTMPFIL K IBTMPA(0) D  G:IBFND=U PAYST G:'IBFND PAYNAM G PAYX
  1.  . S IBK=IBCT,IBFND=$$PAYD(.IBTMPA,0,IBK)
  1.  S IBK=0
  1.  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)
  1.  . S IBD=$G(@IBTMPFIL@(IBK)),IBFND="" I IBD'="" S IBTMPA(IBK)=IBD
  1.  . I IBD=""!(IBJ=5) S IBL=$S(IBK<IBCT:1,IBK=IBCT:0,1:0) D
  1.  . . S IBLM=IBK I 'IBL&(IBK>IBCT) S IBLM=IBCT
  1.  . . S IBFND=$$PAYD(.IBTMPA,IBL,IBLM)
  1.  I IBFND=U G PAYST
  1.  I 'IBFND G PAYNAM
  1.  G PAYX
  1. PAYX ; payer lookup exit point
  1.  K @IBTMPFIL
  1.  ;END
  1.  I IBFND=U S IBFND=""
  1.  Q IBFND
  1.  ;
  1. PSET ;set name into tmp array
  1.  N IBC,IBD
  1.  S IBC=@IBTMPFIL@(0)+1,@IBTMPFIL@(0)=IBC
  1.  S @IBTMPFIL@(IBC)=IBA_U_IBN
  1.  Q
  1.  ;
  1. PAYD(IBARY,IBO,IBLM) ; display up to 5 payer's for selection at a time.
  1.  ; IBARY - 5 items to display
  1.  ; IBO - are there more to display
  1.  ;
  1.  I $O(IBARY(0))="" Q ""
  1.  N DIR,DIRUT,DIROUT,IBA,IBB,IBD,IBM,X,Y
  1.  ; array is payer name ^ payer 365.12 ien
  1.  S DIR(0)="LCO^1:"_IBLM,IBA=0 F  S IBA=$O(IBARY(IBA)) Q:'IBA  D
  1.  . S IBD=IBARY(IBA)
  1.  . ;IB*737/DTG display complete names
  1.  . ;S IBM=$E($P(IBD,U,1),1,35)
  1.  . S IBM=$P(IBD,U,1)
  1.  . W !,?6,IBA,?13,IBM
  1.  S DIR("?")="Enter the Item Number for the Payer desired"
  1.  S DIR("A")="CHOOSE"
  1.  I IBO=1 D
  1.  . S DIR("A",1)="Press "_($S(IBO=1:"<Enter> to see more, ",1:""))_"'^' to exit this list,  OR"
  1.  D ^DIR
  1.  I $E(Y)=U S IBFND=U
  1.  I Y S IBFND=$P(@IBTMPFIL@(+Y),U,2)
  1.  Q IBFND
  1.  ;
  1. HLPBEG ; display help message
  1.  W !,"Select the type of filter to narrow down your list of available Payers:"
  1.  W !,"   Begins with - Displays Payer(s) that begin with the specified text"
  1.  W !,"   Contains    - Displays Payer(s) that contain the specified text"
  1.  W !,"   List        - Displays listing of all Payers"
  1.  Q
  1.  ;
  1. HLPPN ; display help message for payer name
  1.  I FILTER=1 W !,"Enter the Payer's name that you want to Begin With." Q
  1.  I FILTER=2 W !,"Enter the string that you want the Payer's name to Contain." Q
  1.  W !,"Enter Payer Name"
  1.  Q
  1.  ;
  1. PAYLST ; list out payers in payer 'BB' index in groups of 20
  1.  ;
  1.  N DIR,DTOUT,DUOUT,IBA,IBB,IBC,IBOK,X,Y
  1.  W !,"CHOOSE FROM:"
  1.  S IBA="",IBC=0
  1.  ; IB*737/DTG change to use full name cross reference
  1.  ;F  S IBA=$O(^IBE(365.12,"B",IBA)) Q:IBA=""  S IBOK=1,IBC=IBC+1 D  Q:'IBOK
  1.  F  S IBA=$O(^IBE(365.12,"BB",IBA)) Q:IBA=""  S IBOK=1 D  Q:'IBOK
  1.  . S IBB="" F  S IBB=$O(^IBE(365.12,"BB",IBA,IBB)) Q:IBB=""  S IBC=IBC+1 D  Q:'IBOK
  1.  .. W !,IBA
  1.  .. I IBC#20'=0 Q
  1.  .. S DIR(0)="E" D ^DIR K DIR
  1.  .. I $D(DTOUT)!($D(DUOUT)) S IBOK=0
  1.  W !!
  1.  Q
  1.  ;
  1.  ; IB*732/DTG end - change standard DIC call to begins with/contains/list
  1. HELP1 ;This is the help text for RECEIVE IIU DATA (#365.121,5.01)  ICR #: 10142
  1.  N ARR
  1.  S ARR(1,"F")="!"
  1.  S ARR(1)="This field identifies whether the VA facility is allowing Interfacility"
  1.  S ARR(2,"F")="!"
  1.  S ARR(2)="Insurance Update Data to be received and saved into the buffer for processing."
  1.  S ARR(3,"F")="!"
  1.  S ARR(3)="Enter '1' for YES, show policies received from IIU for this payer in the buffer."
  1.  S ARR(4,"F")="!"
  1.  S ARR(4)="Enter '0' for No, don't show policies received from IIU in the buffer."
  1.  S ARR(5,"F")="!"
  1.  D EN^DDIOL(.ARR)
  1.  Q