IBCNES ;ALB/ESG - eIV elig/Benefit screen ; 14-Jul-2009
;;2.0;INTEGRATED BILLING;**416,438,497,506,702,806**;21-MAR-94;Build 19
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
EB(IBVF,IBVIENS,IBVEBFLG,IBVV,IBVSUB) ; entry point for main list display
; see below at tag INIT for a description of the parameters
; IBVSUB is required at this entry point because the ListMan array uses this variable
;
D EN^VALM("IBCNE ELIGIBILITY/BENEFIT INFO")
EBX ;
Q
;
HDR ; -- header code - called by ListManager
; build the header area based on the values of IBVF and IBVIENS
;
; pt. insurance
I IBVF=2.322 D
. N DFN,IBCDFN,PNB,PN,LPID,INS,INSNM,IENS,RSDATE,RSTYPE
. S DFN=+$P(IBVIENS,",",2)
. S IBCDFN=+$P(IBVIENS,",",1)
. S PNB=$$PT^IBEFUNC(DFN)
. S PN=$P(PNB,U,1) ; pt name
. S LPID=$P(PNB,U,2) ; pt id
. S INS=+$P($G(^DPT(DFN,.312,IBCDFN,0)),U,1),INSNM=""
. I INS S INSNM=$P($G(^DIC(36,INS,0)),U,1)
. S IENS=IBCDFN_","_DFN_","
. S RSDATE=$$GET1^DIQ(2.312,IENS,8.01,"I"),RSTYPE=$$GET1^DIQ(2.312,IENS,8.02,"I")
. S VALMHDR(1)=$$FO^IBCNEUT1(PN,30)_" "_$$FO^IBCNEUT1(LPID,15)_" "_$$FO^IBCNEUT1(INSNM,30)
. S VALMHDR(2)="** Based on service date "_$S(RSDATE:$$FMTE^XLFDT(RSDATE,"5Z"),1:"UNKNOWN")_" and service type: "_$S(RSTYPE:$P($G(^IBE(365.013,RSTYPE,0)),U,2),1:"UNKNOWN")_" **"
. S RSPIEN=$$GET1^DIQ(2.312,IENS,8.03,"I")
;
; eIV response file
I IBVF=365.02 D
. N RSPIEN,IBX,DFN,INS,PNB,PN,LPID,INSNM,TQIEN,NODE0,RSTYPE,RSDATE
. S RSPIEN=+IBVIENS
. S IBX=$G(^IBCN(365,RSPIEN,0))
. ; IB*702/TAZ,CKB - Set the RSTYPE=REQUESTED SERVICE TYPE CODE (365,.15), and
. ; RSDATE=REQUESTED SERVICE DATE (365,.14)
. ;S TQIEN=$P(IBX,U,5),NODE0=$G(^IBCN(365.1,TQIEN,0)),RSTYPE=$P(NODE0,U,20)
. S RSTYPE=$$GET1^DIQ(365,RSPIEN_",",.15,"I")
. ;S RSDATE=$P($G(^IBCN(365,RSPIEN,1)),U,10) I RSDATE="" S RSDATE=$P(NODE0,U,12)
. S RSDATE=$P($G(^IBCN(365,RSPIEN,1)),U,10) I RSDATE="" S RSDATE=$$GET1^DIQ(365,RSPIEN_",",.14,"I")
. S DFN=+$P(IBX,U,2) ; pt ien
. S INS=+$P(IBX,U,3) ; payer ien
. S INSNM=""
. S PNB=$$PT^IBEFUNC(DFN)
. S PN=$P(PNB,U,1) ; pt name
. S LPID=$P(PNB,U,2) ; pt id
. I INS S INSNM=$P($G(^IBE(365.12,INS,0)),U,1) ; payer name
. S VALMHDR(1)=$$FO^IBCNEUT1(PN,30)_" "_$$FO^IBCNEUT1(LPID,15)_" "_$$FO^IBCNEUT1(INSNM,30)
. S VALMHDR(2)="** Based on service date "_$S(RSDATE:$$FMTE^XLFDT(RSDATE,"5Z"),1:"UNKNOWN")_" and service type: "_$S(RSTYPE:$P($G(^IBE(365.013,RSTYPE,0)),U,2),1:"UNKNOWN")_" **"
;
I $G(IBBUFDA) D
.N SRVARRAY,Z
.D SERVLN^IBCNBLE(IBBUFDA,.SRVARRAY) I SRVARRAY F Z=1:1:SRVARRAY S VALMHDR(Z+1)=SRVARRAY(Z)
Q
;
INIT(IBVF,IBVIENS,IBVEBFLG,IBVV,IBVSUB) ; List Entry
;
; IBVF = file# 2.322 or 365.02 (required)
; IBVIENS = std IENS list of internal entry numbers - NOT including any EB iens (required)
; IBVEBFLG = flag indicating which EB records to pull
; "A" - all of them
; "L" - only the last one (default)
; "F" - only the first one
; "M" - multiple, pass IBEBFLG by reference and include the IB iens in
; an array as follows:
; IBVEBFLG="M"
; IBVEBFLG(3)=""
; IBVEBFLG(5)=""
; IBVV = Video attributes flag
; 1 = reverse video (default)
; 2 = bold
; 3 = underline
; IBVSUB = literal subscript to use in the display scratch global
;
N IBVDA,GLO,IBVLIST,IEN,IBVEBIEN,IBVEBTOT,IBVEBCNT
;N IBECODE,IIVSTAT,PLNDESC,IBINSTYP,OTHINS,MWNRIEN ;IB*2.0*506 to be used to create EBSummary
;
S OTHINS=0 ;IB*2.0*506/TAZ Initialize Other Insurance variable
S MWNRIEN=$P($G(^IBE(350.9,1,51)),U,25) ;IB*2.0*506/TAZ Initialize Medicare WNR payer IEN
S IBVSUB=$G(IBVSUB)
I IBVSUB="" S IBVSUB="EB ELIG/BEN"
K ^TMP(IBVSUB,$J)
I $D(VALMEVL) D CLEAN^VALM10,KILL^VALM10()
;
D DA^DILF(IBVIENS,.IBVDA) ; build the IBVDA array for the iens
I '$D(IBVDA) D NODATA G INITX
;
I $D(VALMEVL),'$G(IBVV) S IBVV=1 ; default reverse video for ListMan
I '$D(VALMEVL) S IBVV="" ; no video attributes for non-ListMan
;
D RPDM^IBCNES3($S(IBVF=365.02:365,1:2.312),.IBVDA,IBVV,IBVSUB) ; IB*2*497 display group level eligibility information
;
I IBVF=2.322 S GLO=$NA(^DPT(+$G(IBVDA(1)),.312,+$G(IBVDA),6)) ; pt. insurance
I IBVF=365.02 S GLO=$NA(^IBCN(365,+$G(IBVDA),2)) ; response file
I $G(GLO)="" D NODATA G INITX
;
S IBVEBFLG=$G(IBVEBFLG,"L")
K IBVLIST
I IBVEBFLG="L" S IEN=+$O(@GLO@(" "),-1) I IEN S IBVLIST(IEN)="" ; last EB ien on file
I IBVEBFLG="F" S IEN=+$O(@GLO@(0)) I IEN S IBVLIST(IEN)="" ; first EB ien on file
I IBVEBFLG="A" S IEN=0 F S IEN=$O(@GLO@(IEN)) Q:'IEN S IBVLIST(IEN)="" ; all EB iens on file
I IBVEBFLG="M" S IEN=0 F S IEN=$O(IBVEBFLG(IEN)) Q:'IEN I $D(@GLO@(IEN)) S IBVLIST(IEN)="" ; multiple
;
I '$D(IBVLIST) D NODATA G INITX
;
; count them
S IEN=0 F IBVEBTOT=0:1 S IEN=$O(IBVLIST(IEN)) Q:'IEN
I 'IBVEBTOT D NODATA G INITX
;
;IB*506 - Count EBs and gather EB Summary Data
; IB*806 All related code to IB*506 for EB count and EB Summary Data was replaced
;
D SUMMARY ; Summary of EB loops
;
I 'IBVEBTOT D NODATA G INITX
;
S IBVEBIEN=1,IBVEBCNT=0 ;IB*806/DJW initialize IBVEBIEN to 1 to skip 1st EB loop (FSC generated loop)
F S IBVEBIEN=$O(IBVLIST(IBVEBIEN)) Q:'IBVEBIEN D
. S IBVEBCNT=IBVEBCNT+1
. N TXVIENS
. ;
. ; if there is more than 1 EB group, then display a header line for separation
. I IBVEBTOT>1 D
.. N DSP,LN,IBZ
.. S DSP=$NA(^TMP(IBVSUB,$J,"DISP"))
.. S LN=+$O(@DSP@(""),-1)
.. S IBZ="eIV Eligibility/Benefit Data Group# "_IBVEBCNT_" of "_(IBVEBTOT-1) ;IB*806 added -1
.. S IBZ=$$FO^IBCNEUT1($J("",20)_IBZ,80)
.. S LN=LN+1 D SET^IBCNES1(LN,1,IBZ,,IBVV) ;section hdr "eIV Elig ... x of x"
.. S IBZ="---------------------------------------------"
.. S IBZ=$$FO^IBCNEUT1($J("",20)_IBZ,80)
.. S LN=LN+1 D SET^IBCNES1(LN,1,IBZ,,IBVV)
. ;
. ; add this EB ien to the list of iens
. S TXVIENS=IBVEBIEN_","_IBVIENS
. ;
. ; call the screen sections to build the display
. D EB^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
. D CMPI^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
. D HCSD^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
. D NTE^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
. D BRE^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
;
S VALMCNT=$O(^TMP(IBVSUB,$J,"DISP"," "),-1)
;
INITX ;
Q
;
SUMMARY ;
N ARRAY,DSP,LN,IBZ,IBINSTYP,IBPEDT,XX,HLDT,IIVSTAT,DFN,RSPIEN,IBX,DATA
;
KILL ARRAY
;
I IBVF=2.322 D
. S DFN=+$G(IBVDA(1))
. S RSPIEN=$$GET1^DIQ(2.312,+$G(IBVDA)_","_DFN_",",8.03,"I")
I IBVF=365.02 D
. S RSPIEN=+$G(IBVDA)
. S IBX=$G(^IBCN(365,RSPIEN,0)),DFN=+$P(IBX,U,2)
;
S DSP=$NA(^TMP(IBVSUB,$J,"DISP"))
S LN=+$O(@DSP@(""),-1)
S IBZ="Summary of eIV Eligibility/Benefit Data"
S IBZ=$$FO^IBCNEUT1($J("",20)_IBZ,80)
S LN=LN+1 D SET^IBCNES1(LN,1,IBZ,,IBVV)
S IBZ="---------------------------------------"
S IBZ=$$FO^IBCNEUT1($J("",20)_IBZ,80)
S LN=LN+1 D SET^IBCNES1(LN,1,IBZ,,IBVV)
;
D EBSUMMARY^IBCNEUT2(DFN,RSPIEN,"",.ARRAY)
;
S IBPEDT=$P($G(RPTDATA(1)),U,11) ; get Effective dt from above
I '$O(ARRAY(0)) D G SUMX ; IB*806/DTG blank summary section use $O instead of $D
. S LN=LN+1 D SET^IBCNES1(LN,1,"Insurance Type","Unknown")
. S LN=LN+1 D SET^IBCNES1(LN,5,"Coverage Status","Unknown")
. S LN=LN+1 D SET^IBCNES1(LN,5,"Plan Date/Effective Date",$S(IBPEDT'="":IBPEDT,1:"Unknown")) ;use eff dt from above / uknown if not there
. S LN=LN+1 D SET^IBCNES1(LN)
;
S XX="" F S XX=$O(ARRAY(XX)) Q:XX="" D
. S IBINSTYP="" F S IBINSTYP=$O(ARRAY(XX,IBINSTYP)) Q:IBINSTYP="" D
.. S DATA=ARRAY(XX,IBINSTYP),IIVSTAT=$P(DATA,U,5),HLDT=$$FMTE^XLFDT($P(DATA,U,3),"5Z")
.. ;I HLDT="" S HLDT="Unknown"
.. I HLDT="" S HLDT=IBPEDT ; use eff dt from above
.. I HLDT="" S HLDT="Unknown" ; if date is still null use Unknown
.. S LN=LN+1 D SET^IBCNES1(LN,1,"Insurance Type",IBINSTYP)
.. S LN=LN+1 D SET^IBCNES1(LN,5,"Coverage Status",IIVSTAT)
.. S LN=LN+1 D SET^IBCNES1(LN,5,"Plan Date/Effective Date",HLDT)
.. S LN=LN+1 D SET^IBCNES1(LN)
;
I $D(ARRAY("OHI")) D
. S LN=LN+1 D SET^IBCNES1(LN,1,"Other insurance was potentially found")
. S LN=LN+1 D SET^IBCNES1(LN)
;
SUMX ; end of summary section ;IB*806/DTG
;
Q
;
NODATA ; display no data found
N DSP,LN
S DSP=$NA(^TMP(IBVSUB,$J,"DISP")) ; scratch global display array
S LN=+$O(@DSP@(""),-1) ; last line# used in scratch global
S LN=LN+1 D SET^IBCNES1(LN)
S LN=LN+1 D SET^IBCNES1(LN,5,"No eIV Eligibility/Benefit Data Found")
S VALMCNT=$O(^TMP(IBVSUB,$J,"DISP"," "),-1)
NODATAX ;
Q
;
HELP ; -- help code
S X="?",VALMANS="??" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP(IBVSUB,$J)
I $D(VALMEVL) D CLEAN^VALM10,KILL^VALM10()
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNES 8956 printed Jan 29, 2026@15:14:16 Page 2
IBCNES ;ALB/ESG - eIV elig/Benefit screen ; 14-Jul-2009
+1 ;;2.0;INTEGRATED BILLING;**416,438,497,506,702,806**;21-MAR-94;Build 19
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EB(IBVF,IBVIENS,IBVEBFLG,IBVV,IBVSUB) ; entry point for main list display
+1 ; see below at tag INIT for a description of the parameters
+2 ; IBVSUB is required at this entry point because the ListMan array uses this variable
+3 ;
+4 DO EN^VALM("IBCNE ELIGIBILITY/BENEFIT INFO")
EBX ;
+1 QUIT
+2 ;
HDR ; -- header code - called by ListManager
+1 ; build the header area based on the values of IBVF and IBVIENS
+2 ;
+3 ; pt. insurance
+4 IF IBVF=2.322
Begin DoDot:1
+5 NEW DFN,IBCDFN,PNB,PN,LPID,INS,INSNM,IENS,RSDATE,RSTYPE
+6 SET DFN=+$PIECE(IBVIENS,",",2)
+7 SET IBCDFN=+$PIECE(IBVIENS,",",1)
+8 SET PNB=$$PT^IBEFUNC(DFN)
+9 ; pt name
SET PN=$PIECE(PNB,U,1)
+10 ; pt id
SET LPID=$PIECE(PNB,U,2)
+11 SET INS=+$PIECE($GET(^DPT(DFN,.312,IBCDFN,0)),U,1)
SET INSNM=""
+12 IF INS
SET INSNM=$PIECE($GET(^DIC(36,INS,0)),U,1)
+13 SET IENS=IBCDFN_","_DFN_","
+14 SET RSDATE=$$GET1^DIQ(2.312,IENS,8.01,"I")
SET RSTYPE=$$GET1^DIQ(2.312,IENS,8.02,"I")
+15 SET VALMHDR(1)=$$FO^IBCNEUT1(PN,30)_" "_$$FO^IBCNEUT1(LPID,15)_" "_$$FO^IBCNEUT1(INSNM,30)
+16 SET VALMHDR(2)="** Based on service date "_$SELECT(RSDATE:$$FMTE^XLFDT(RSDATE,"5Z"),1:"UNKNOWN")_" and service type: "_$SELECT(RSTYPE:$PIECE($GET(^IBE(365.013,RSTYPE,0)),U,2),1:"UNKNOWN")_" **"
+17 SET RSPIEN=$$GET1^DIQ(2.312,IENS,8.03,"I")
End DoDot:1
+18 ;
+19 ; eIV response file
+20 IF IBVF=365.02
Begin DoDot:1
+21 NEW RSPIEN,IBX,DFN,INS,PNB,PN,LPID,INSNM,TQIEN,NODE0,RSTYPE,RSDATE
+22 SET RSPIEN=+IBVIENS
+23 SET IBX=$GET(^IBCN(365,RSPIEN,0))
+24 ; IB*702/TAZ,CKB - Set the RSTYPE=REQUESTED SERVICE TYPE CODE (365,.15), and
+25 ; RSDATE=REQUESTED SERVICE DATE (365,.14)
+26 ;S TQIEN=$P(IBX,U,5),NODE0=$G(^IBCN(365.1,TQIEN,0)),RSTYPE=$P(NODE0,U,20)
+27 SET RSTYPE=$$GET1^DIQ(365,RSPIEN_",",.15,"I")
+28 ;S RSDATE=$P($G(^IBCN(365,RSPIEN,1)),U,10) I RSDATE="" S RSDATE=$P(NODE0,U,12)
+29 SET RSDATE=$PIECE($GET(^IBCN(365,RSPIEN,1)),U,10)
IF RSDATE=""
SET RSDATE=$$GET1^DIQ(365,RSPIEN_",",.14,"I")
+30 ; pt ien
SET DFN=+$PIECE(IBX,U,2)
+31 ; payer ien
SET INS=+$PIECE(IBX,U,3)
+32 SET INSNM=""
+33 SET PNB=$$PT^IBEFUNC(DFN)
+34 ; pt name
SET PN=$PIECE(PNB,U,1)
+35 ; pt id
SET LPID=$PIECE(PNB,U,2)
+36 ; payer name
IF INS
SET INSNM=$PIECE($GET(^IBE(365.12,INS,0)),U,1)
+37 SET VALMHDR(1)=$$FO^IBCNEUT1(PN,30)_" "_$$FO^IBCNEUT1(LPID,15)_" "_$$FO^IBCNEUT1(INSNM,30)
+38 SET VALMHDR(2)="** Based on service date "_$SELECT(RSDATE:$$FMTE^XLFDT(RSDATE,"5Z"),1:"UNKNOWN")_" and service type: "_$SELECT(RSTYPE:$PIECE($GET(^IBE(365.013,RSTYPE,0)),U,2),1:"UNKNOWN")_" **"
End DoDot:1
+39 ;
+40 IF $GET(IBBUFDA)
Begin DoDot:1
+41 NEW SRVARRAY,Z
+42 DO SERVLN^IBCNBLE(IBBUFDA,.SRVARRAY)
IF SRVARRAY
FOR Z=1:1:SRVARRAY
SET VALMHDR(Z+1)=SRVARRAY(Z)
End DoDot:1
+43 QUIT
+44 ;
INIT(IBVF,IBVIENS,IBVEBFLG,IBVV,IBVSUB) ; List Entry
+1 ;
+2 ; IBVF = file# 2.322 or 365.02 (required)
+3 ; IBVIENS = std IENS list of internal entry numbers - NOT including any EB iens (required)
+4 ; IBVEBFLG = flag indicating which EB records to pull
+5 ; "A" - all of them
+6 ; "L" - only the last one (default)
+7 ; "F" - only the first one
+8 ; "M" - multiple, pass IBEBFLG by reference and include the IB iens in
+9 ; an array as follows:
+10 ; IBVEBFLG="M"
+11 ; IBVEBFLG(3)=""
+12 ; IBVEBFLG(5)=""
+13 ; IBVV = Video attributes flag
+14 ; 1 = reverse video (default)
+15 ; 2 = bold
+16 ; 3 = underline
+17 ; IBVSUB = literal subscript to use in the display scratch global
+18 ;
+19 NEW IBVDA,GLO,IBVLIST,IEN,IBVEBIEN,IBVEBTOT,IBVEBCNT
+20 ;N IBECODE,IIVSTAT,PLNDESC,IBINSTYP,OTHINS,MWNRIEN ;IB*2.0*506 to be used to create EBSummary
+21 ;
+22 ;IB*2.0*506/TAZ Initialize Other Insurance variable
SET OTHINS=0
+23 ;IB*2.0*506/TAZ Initialize Medicare WNR payer IEN
SET MWNRIEN=$PIECE($GET(^IBE(350.9,1,51)),U,25)
+24 SET IBVSUB=$GET(IBVSUB)
+25 IF IBVSUB=""
SET IBVSUB="EB ELIG/BEN"
+26 KILL ^TMP(IBVSUB,$JOB)
+27 IF $DATA(VALMEVL)
DO CLEAN^VALM10
DO KILL^VALM10()
+28 ;
+29 ; build the IBVDA array for the iens
DO DA^DILF(IBVIENS,.IBVDA)
+30 IF '$DATA(IBVDA)
DO NODATA
GOTO INITX
+31 ;
+32 ; default reverse video for ListMan
IF $DATA(VALMEVL)
IF '$GET(IBVV)
SET IBVV=1
+33 ; no video attributes for non-ListMan
IF '$DATA(VALMEVL)
SET IBVV=""
+34 ;
+35 ; IB*2*497 display group level eligibility information
DO RPDM^IBCNES3($SELECT(IBVF=365.02:365,1:2.312),.IBVDA,IBVV,IBVSUB)
+36 ;
+37 ; pt. insurance
IF IBVF=2.322
SET GLO=$NAME(^DPT(+$GET(IBVDA(1)),.312,+$GET(IBVDA),6))
+38 ; response file
IF IBVF=365.02
SET GLO=$NAME(^IBCN(365,+$GET(IBVDA),2))
+39 IF $GET(GLO)=""
DO NODATA
GOTO INITX
+40 ;
+41 SET IBVEBFLG=$GET(IBVEBFLG,"L")
+42 KILL IBVLIST
+43 ; last EB ien on file
IF IBVEBFLG="L"
SET IEN=+$ORDER(@GLO@(" "),-1)
IF IEN
SET IBVLIST(IEN)=""
+44 ; first EB ien on file
IF IBVEBFLG="F"
SET IEN=+$ORDER(@GLO@(0))
IF IEN
SET IBVLIST(IEN)=""
+45 ; all EB iens on file
IF IBVEBFLG="A"
SET IEN=0
FOR
SET IEN=$ORDER(@GLO@(IEN))
if 'IEN
QUIT
SET IBVLIST(IEN)=""
+46 ; multiple
IF IBVEBFLG="M"
SET IEN=0
FOR
SET IEN=$ORDER(IBVEBFLG(IEN))
if 'IEN
QUIT
IF $DATA(@GLO@(IEN))
SET IBVLIST(IEN)=""
+47 ;
+48 IF '$DATA(IBVLIST)
DO NODATA
GOTO INITX
+49 ;
+50 ; count them
+51 SET IEN=0
FOR IBVEBTOT=0:1
SET IEN=$ORDER(IBVLIST(IEN))
if 'IEN
QUIT
+52 IF 'IBVEBTOT
DO NODATA
GOTO INITX
+53 ;
+54 ;IB*506 - Count EBs and gather EB Summary Data
+55 ; IB*806 All related code to IB*506 for EB count and EB Summary Data was replaced
+56 ;
+57 ; Summary of EB loops
DO SUMMARY
+58 ;
+59 IF 'IBVEBTOT
DO NODATA
GOTO INITX
+60 ;
+61 ;IB*806/DJW initialize IBVEBIEN to 1 to skip 1st EB loop (FSC generated loop)
SET IBVEBIEN=1
SET IBVEBCNT=0
+62 FOR
SET IBVEBIEN=$ORDER(IBVLIST(IBVEBIEN))
if 'IBVEBIEN
QUIT
Begin DoDot:1
+63 SET IBVEBCNT=IBVEBCNT+1
+64 NEW TXVIENS
+65 ;
+66 ; if there is more than 1 EB group, then display a header line for separation
+67 IF IBVEBTOT>1
Begin DoDot:2
+68 NEW DSP,LN,IBZ
+69 SET DSP=$NAME(^TMP(IBVSUB,$JOB,"DISP"))
+70 SET LN=+$ORDER(@DSP@(""),-1)
+71 ;IB*806 added -1
SET IBZ="eIV Eligibility/Benefit Data Group# "_IBVEBCNT_" of "_(IBVEBTOT-1)
+72 SET IBZ=$$FO^IBCNEUT1($JUSTIFY("",20)_IBZ,80)
+73 ;section hdr "eIV Elig ... x of x"
SET LN=LN+1
DO SET^IBCNES1(LN,1,IBZ,,IBVV)
+74 SET IBZ="---------------------------------------------"
+75 SET IBZ=$$FO^IBCNEUT1($JUSTIFY("",20)_IBZ,80)
+76 SET LN=LN+1
DO SET^IBCNES1(LN,1,IBZ,,IBVV)
End DoDot:2
+77 ;
+78 ; add this EB ien to the list of iens
+79 SET TXVIENS=IBVEBIEN_","_IBVIENS
+80 ;
+81 ; call the screen sections to build the display
+82 DO EB^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
+83 DO CMPI^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
+84 DO HCSD^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
+85 DO NTE^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
+86 DO BRE^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
End DoDot:1
+87 ;
+88 SET VALMCNT=$ORDER(^TMP(IBVSUB,$JOB,"DISP"," "),-1)
+89 ;
INITX ;
+1 QUIT
+2 ;
SUMMARY ;
+1 NEW ARRAY,DSP,LN,IBZ,IBINSTYP,IBPEDT,XX,HLDT,IIVSTAT,DFN,RSPIEN,IBX,DATA
+2 ;
+3 KILL ARRAY
+4 ;
+5 IF IBVF=2.322
Begin DoDot:1
+6 SET DFN=+$GET(IBVDA(1))
+7 SET RSPIEN=$$GET1^DIQ(2.312,+$GET(IBVDA)_","_DFN_",",8.03,"I")
End DoDot:1
+8 IF IBVF=365.02
Begin DoDot:1
+9 SET RSPIEN=+$GET(IBVDA)
+10 SET IBX=$GET(^IBCN(365,RSPIEN,0))
SET DFN=+$PIECE(IBX,U,2)
End DoDot:1
+11 ;
+12 SET DSP=$NAME(^TMP(IBVSUB,$JOB,"DISP"))
+13 SET LN=+$ORDER(@DSP@(""),-1)
+14 SET IBZ="Summary of eIV Eligibility/Benefit Data"
+15 SET IBZ=$$FO^IBCNEUT1($JUSTIFY("",20)_IBZ,80)
+16 SET LN=LN+1
DO SET^IBCNES1(LN,1,IBZ,,IBVV)
+17 SET IBZ="---------------------------------------"
+18 SET IBZ=$$FO^IBCNEUT1($JUSTIFY("",20)_IBZ,80)
+19 SET LN=LN+1
DO SET^IBCNES1(LN,1,IBZ,,IBVV)
+20 ;
+21 DO EBSUMMARY^IBCNEUT2(DFN,RSPIEN,"",.ARRAY)
+22 ;
+23 ; get Effective dt from above
SET IBPEDT=$PIECE($GET(RPTDATA(1)),U,11)
+24 ; IB*806/DTG blank summary section use $O instead of $D
IF '$ORDER(ARRAY(0))
Begin DoDot:1
+25 SET LN=LN+1
DO SET^IBCNES1(LN,1,"Insurance Type","Unknown")
+26 SET LN=LN+1
DO SET^IBCNES1(LN,5,"Coverage Status","Unknown")
+27 ;use eff dt from above / uknown if not there
SET LN=LN+1
DO SET^IBCNES1(LN,5,"Plan Date/Effective Date",$SELECT(IBPEDT'="":IBPEDT,1:"Unknown"))
+28 SET LN=LN+1
DO SET^IBCNES1(LN)
End DoDot:1
GOTO SUMX
+29 ;
+30 SET XX=""
FOR
SET XX=$ORDER(ARRAY(XX))
if XX=""
QUIT
Begin DoDot:1
+31 SET IBINSTYP=""
FOR
SET IBINSTYP=$ORDER(ARRAY(XX,IBINSTYP))
if IBINSTYP=""
QUIT
Begin DoDot:2
+32 SET DATA=ARRAY(XX,IBINSTYP)
SET IIVSTAT=$PIECE(DATA,U,5)
SET HLDT=$$FMTE^XLFDT($PIECE(DATA,U,3),"5Z")
+33 ;I HLDT="" S HLDT="Unknown"
+34 ; use eff dt from above
IF HLDT=""
SET HLDT=IBPEDT
+35 ; if date is still null use Unknown
IF HLDT=""
SET HLDT="Unknown"
+36 SET LN=LN+1
DO SET^IBCNES1(LN,1,"Insurance Type",IBINSTYP)
+37 SET LN=LN+1
DO SET^IBCNES1(LN,5,"Coverage Status",IIVSTAT)
+38 SET LN=LN+1
DO SET^IBCNES1(LN,5,"Plan Date/Effective Date",HLDT)
+39 SET LN=LN+1
DO SET^IBCNES1(LN)
End DoDot:2
End DoDot:1
+40 ;
+41 IF $DATA(ARRAY("OHI"))
Begin DoDot:1
+42 SET LN=LN+1
DO SET^IBCNES1(LN,1,"Other insurance was potentially found")
+43 SET LN=LN+1
DO SET^IBCNES1(LN)
End DoDot:1
+44 ;
SUMX ; end of summary section ;IB*806/DTG
+1 ;
+2 QUIT
+3 ;
NODATA ; display no data found
+1 NEW DSP,LN
+2 ; scratch global display array
SET DSP=$NAME(^TMP(IBVSUB,$JOB,"DISP"))
+3 ; last line# used in scratch global
SET LN=+$ORDER(@DSP@(""),-1)
+4 SET LN=LN+1
DO SET^IBCNES1(LN)
+5 SET LN=LN+1
DO SET^IBCNES1(LN,5,"No eIV Eligibility/Benefit Data Found")
+6 SET VALMCNT=$ORDER(^TMP(IBVSUB,$JOB,"DISP"," "),-1)
NODATAX ;
+1 QUIT
+2 ;
HELP ; -- help code
+1 SET X="?"
SET VALMANS="??"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP(IBVSUB,$JOB)
+2 IF $DATA(VALMEVL)
DO CLEAN^VALM10
DO KILL^VALM10()
+3 QUIT
