- IBCNES ;ALB/ESG - eIV elig/Benefit screen ; 14-Jul-2009
- ;;2.0;INTEGRATED BILLING;**416,438,497,506,702**;21-MAR-94;Build 53
- ;;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")_" **"
- . Q
- ;
- ; 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")_" **"
- . Q
- ;
- 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
- 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
- ;
- 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*2.0*506 Beginning
- ; Count EBs and gather EB Summary Data
- ; IIVSTAT will tell us the coverage status 1,6, or V (File #365.011)
- ; Flag related to IBINSTYP will tell us the insurance type (File #365.014)
- ; OTHINS will tell us if Other Insurance was indicated on the response
- ;
- S (IEN,IBVEBTOT,OTHINS)=0,(IIVSTAT,IBINSTYP,PLNDESC)=""
- F S IEN=$O(IBVLIST(IEN)) D Q:'IEN
- . Q:'IEN
- . S IBVEBTOT=IBVEBTOT+1 ; total # of EBs
- . I IBVEBTOT=1 D
- . . S IBECODE=$P($G(@GLO@(1,0)),U,2) ; Eligibility/Benefits Code
- . . S PLNDESC=$P($G(@GLO@(1,0)),U,6) ; Plan Description
- . . I PLNDESC'="eIV Eligibility Determination" S IIVSTAT="V"
- . . I IBECODE=1 S IIVSTAT=1 ; active
- . . I IBECODE=6 S IIVSTAT=6 ; inactive
- . . I IIVSTAT="" S IIVSTAT="V" ; ambigious
- . . ;
- . I IBINSTYP="" D
- . . S IBINSTYP=$P($G(@GLO@(IEN,0)),U,5) ; Insurance Type (check all EBs, get 1st occurrence)
- . . I IBINSTYP="" Q ; no insurance type found
- . . S IBINSTYP=$$GET1^DIQ(365.014,IBINSTYP,.02)
- . ;
- . ;Screen out non_Medicare records
- . S MWNRIEN=$P($G(^IBE(350.9,1,51)),U,25) ; Initialize Medicare WNR payer IEN
- . I IBVF=2.322,($$GET1^DIQ(36,$P(^DPT(+$G(IBVDA(1)),.312,+$G(IBVDA),0),U,1)_",",3.1,"I")'=MWNRIEN) Q
- . I IBVF=365.02,($P(^IBCN(365,+$G(IBVDA),0),U,3)'=MWNRIEN) Q
- . ;
- . N IBEIEN,IBELIG
- . S IBEIEN=0
- . F S IBEIEN=$O(@GLO@(IBEIEN)) Q:'IBEIEN D I OTHINS Q
- .. ;Get Eligibility Code. We want R codes only.
- .. S IBELIG=$P($G(@GLO@(IBEIEN,0)),U,2) I $P($G(^IBE(365.011,IBELIG,0)),U,1)="R" S OTHINS=1
- ;
- I IBVEBTOT D SUMMARY(IIVSTAT,IBINSTYP,OTHINS)
- ; /IB*2.0*506 End
- ;
- I 'IBVEBTOT D NODATA G INITX
- ;
- S (IBVEBIEN,IBVEBCNT)=0
- 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
- .. S IBZ=$$FO^IBCNEUT1($J("",20)_IBZ,80)
- .. S LN=LN+1 D SET^IBCNES1(LN,1,IBZ,,IBVV)
- .. S LN=LN+1 D SET^IBCNES1(LN)
- .. Q
- . ;
- . ; 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)
- . ;
- . Q
- ;
- S VALMCNT=$O(^TMP(IBVSUB,$J,"DISP"," "),-1)
- ;
- INITX ;
- Q
- ;
- SUMMARY(IIVSTAT,IBINSTYP,OTHINS) ; (New w/ IB*2.0*506) key data from the Eligibility Benefit Information
- N DSP,LN,IBZ
- ;
- S IIVSTAT=$S(IIVSTAT=1:"ACTIVE",IIVSTAT=6:"INACTIVE",1:"AMBIGUOUS")
- ;
- 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 LN=LN+1 D SET^IBCNES1(LN)
- ;
- S LN=LN+1 D SET^IBCNES1(LN,1,"Coverage Status",IIVSTAT)
- S LN=LN+1 D SET^IBCNES1(LN,1,"Insurance Type",IBINSTYP)
- ;
- I OTHINS S LN=LN+1 D SET^IBCNES1(LN,1,"Other insurance was potentially found")
- S LN=LN+1 D SET^IBCNES1(LN)
- 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 8880 printed Jan 18, 2025@03:16:34 Page 2
- IBCNES ;ALB/ESG - eIV elig/Benefit screen ; 14-Jul-2009
- +1 ;;2.0;INTEGRATED BILLING;**416,438,497,506,702**;21-MAR-94;Build 53
- +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 QUIT
- 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")_" **"
- +39 QUIT
- End DoDot:1
- +40 ;
- +41 IF $GET(IBBUFDA)
- Begin DoDot:1
- +42 NEW SRVARRAY,Z
- +43 DO SERVLN^IBCNBLE(IBBUFDA,.SRVARRAY)
- IF SRVARRAY
- FOR Z=1:1:SRVARRAY
- SET VALMHDR(Z+1)=SRVARRAY(Z)
- +44 QUIT
- End DoDot:1
- +45 QUIT
- +46 ;
- 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 ;IB*2.0*506
- NEW IBECODE,IIVSTAT,PLNDESC,IBINSTYP,OTHINS,MWNRIEN
- +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*2.0*506 Beginning
- +55 ; Count EBs and gather EB Summary Data
- +56 ; IIVSTAT will tell us the coverage status 1,6, or V (File #365.011)
- +57 ; Flag related to IBINSTYP will tell us the insurance type (File #365.014)
- +58 ; OTHINS will tell us if Other Insurance was indicated on the response
- +59 ;
- +60 SET (IEN,IBVEBTOT,OTHINS)=0
- SET (IIVSTAT,IBINSTYP,PLNDESC)=""
- +61 FOR
- SET IEN=$ORDER(IBVLIST(IEN))
- Begin DoDot:1
- +62 if 'IEN
- QUIT
- +63 ; total # of EBs
- SET IBVEBTOT=IBVEBTOT+1
- +64 IF IBVEBTOT=1
- Begin DoDot:2
- +65 ; Eligibility/Benefits Code
- SET IBECODE=$PIECE($GET(@GLO@(1,0)),U,2)
- +66 ; Plan Description
- SET PLNDESC=$PIECE($GET(@GLO@(1,0)),U,6)
- +67 IF PLNDESC'="eIV Eligibility Determination"
- SET IIVSTAT="V"
- +68 ; active
- IF IBECODE=1
- SET IIVSTAT=1
- +69 ; inactive
- IF IBECODE=6
- SET IIVSTAT=6
- +70 ; ambigious
- IF IIVSTAT=""
- SET IIVSTAT="V"
- +71 ;
- End DoDot:2
- +72 IF IBINSTYP=""
- Begin DoDot:2
- +73 ; Insurance Type (check all EBs, get 1st occurrence)
- SET IBINSTYP=$PIECE($GET(@GLO@(IEN,0)),U,5)
- +74 ; no insurance type found
- IF IBINSTYP=""
- QUIT
- +75 SET IBINSTYP=$$GET1^DIQ(365.014,IBINSTYP,.02)
- End DoDot:2
- +76 ;
- +77 ;Screen out non_Medicare records
- +78 ; Initialize Medicare WNR payer IEN
- SET MWNRIEN=$PIECE($GET(^IBE(350.9,1,51)),U,25)
- +79 IF IBVF=2.322
- IF ($$GET1^DIQ(36,$PIECE(^DPT(+$GET(IBVDA(1)),.312,+$GET(IBVDA),0),U,1)_",",3.1,"I")'=MWNRIEN)
- QUIT
- +80 IF IBVF=365.02
- IF ($PIECE(^IBCN(365,+$GET(IBVDA),0),U,3)'=MWNRIEN)
- QUIT
- +81 ;
- +82 NEW IBEIEN,IBELIG
- +83 SET IBEIEN=0
- +84 FOR
- SET IBEIEN=$ORDER(@GLO@(IBEIEN))
- if 'IBEIEN
- QUIT
- Begin DoDot:2
- +85 ;Get Eligibility Code. We want R codes only.
- +86 SET IBELIG=$PIECE($GET(@GLO@(IBEIEN,0)),U,2)
- IF $PIECE($GET(^IBE(365.011,IBELIG,0)),U,1)="R"
- SET OTHINS=1
- End DoDot:2
- IF OTHINS
- QUIT
- End DoDot:1
- if 'IEN
- QUIT
- +87 ;
- +88 IF IBVEBTOT
- DO SUMMARY(IIVSTAT,IBINSTYP,OTHINS)
- +89 ; /IB*2.0*506 End
- +90 ;
- +91 IF 'IBVEBTOT
- DO NODATA
- GOTO INITX
- +92 ;
- +93 SET (IBVEBIEN,IBVEBCNT)=0
- +94 FOR
- SET IBVEBIEN=$ORDER(IBVLIST(IBVEBIEN))
- if 'IBVEBIEN
- QUIT
- Begin DoDot:1
- +95 SET IBVEBCNT=IBVEBCNT+1
- +96 NEW TXVIENS
- +97 ;
- +98 ; if there is more than 1 EB group, then display a header line for separation
- +99 IF IBVEBTOT>1
- Begin DoDot:2
- +100 NEW DSP,LN,IBZ
- +101 SET DSP=$NAME(^TMP(IBVSUB,$JOB,"DISP"))
- +102 SET LN=+$ORDER(@DSP@(""),-1)
- +103 SET IBZ="eIV Eligibility/Benefit Data Group# "_IBVEBCNT_" of "_IBVEBTOT
- +104 SET IBZ=$$FO^IBCNEUT1($JUSTIFY("",20)_IBZ,80)
- +105 SET LN=LN+1
- DO SET^IBCNES1(LN,1,IBZ,,IBVV)
- +106 SET LN=LN+1
- DO SET^IBCNES1(LN)
- +107 QUIT
- End DoDot:2
- +108 ;
- +109 ; add this EB ien to the list of iens
- +110 SET TXVIENS=IBVEBIEN_","_IBVIENS
- +111 ;
- +112 ; call the screen sections to build the display
- +113 DO EB^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
- +114 DO CMPI^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
- +115 DO HCSD^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
- +116 DO NTE^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
- +117 DO BRE^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
- +118 ;
- +119 QUIT
- End DoDot:1
- +120 ;
- +121 SET VALMCNT=$ORDER(^TMP(IBVSUB,$JOB,"DISP"," "),-1)
- +122 ;
- INITX ;
- +1 QUIT
- +2 ;
- SUMMARY(IIVSTAT,IBINSTYP,OTHINS) ; (New w/ IB*2.0*506) key data from the Eligibility Benefit Information
- +1 NEW DSP,LN,IBZ
- +2 ;
- +3 SET IIVSTAT=$SELECT(IIVSTAT=1:"ACTIVE",IIVSTAT=6:"INACTIVE",1:"AMBIGUOUS")
- +4 ;
- +5 SET DSP=$NAME(^TMP(IBVSUB,$JOB,"DISP"))
- +6 SET LN=+$ORDER(@DSP@(""),-1)
- +7 SET IBZ="Summary of eIV Eligibility/Benefit Data"
- +8 SET IBZ=$$FO^IBCNEUT1($JUSTIFY("",20)_IBZ,80)
- +9 SET LN=LN+1
- DO SET^IBCNES1(LN,1,IBZ,,IBVV)
- +10 SET LN=LN+1
- DO SET^IBCNES1(LN)
- +11 ;
- +12 SET LN=LN+1
- DO SET^IBCNES1(LN,1,"Coverage Status",IIVSTAT)
- +13 SET LN=LN+1
- DO SET^IBCNES1(LN,1,"Insurance Type",IBINSTYP)
- +14 ;
- +15 IF OTHINS
- SET LN=LN+1
- DO SET^IBCNES1(LN,1,"Other insurance was potentially found")
- +16 SET LN=LN+1
- DO SET^IBCNES1(LN)
- +17 QUIT
- +18 ;
- 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
- +4 ;