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

IBCNES.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. EB(IBVF,IBVIENS,IBVEBFLG,IBVV,IBVSUB) ; entry point for main list display
  1. ; see below at tag INIT for a description of the parameters
  1. ; IBVSUB is required at this entry point because the ListMan array uses this variable
  1. ;
  1. D EN^VALM("IBCNE ELIGIBILITY/BENEFIT INFO")
  1. EBX ;
  1. Q
  1. ;
  1. HDR ; -- header code - called by ListManager
  1. ; build the header area based on the values of IBVF and IBVIENS
  1. ;
  1. ; pt. insurance
  1. I IBVF=2.322 D
  1. . N DFN,IBCDFN,PNB,PN,LPID,INS,INSNM,IENS,RSDATE,RSTYPE
  1. . S DFN=+$P(IBVIENS,",",2)
  1. . S IBCDFN=+$P(IBVIENS,",",1)
  1. . S PNB=$$PT^IBEFUNC(DFN)
  1. . S PN=$P(PNB,U,1) ; pt name
  1. . S LPID=$P(PNB,U,2) ; pt id
  1. . S INS=+$P($G(^DPT(DFN,.312,IBCDFN,0)),U,1),INSNM=""
  1. . I INS S INSNM=$P($G(^DIC(36,INS,0)),U,1)
  1. . S IENS=IBCDFN_","_DFN_","
  1. . S RSDATE=$$GET1^DIQ(2.312,IENS,8.01,"I"),RSTYPE=$$GET1^DIQ(2.312,IENS,8.02,"I")
  1. . S VALMHDR(1)=$$FO^IBCNEUT1(PN,30)_" "_$$FO^IBCNEUT1(LPID,15)_" "_$$FO^IBCNEUT1(INSNM,30)
  1. . 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")_" **"
  1. . Q
  1. ;
  1. ; eIV response file
  1. I IBVF=365.02 D
  1. . N RSPIEN,IBX,DFN,INS,PNB,PN,LPID,INSNM,TQIEN,NODE0,RSTYPE,RSDATE
  1. . S RSPIEN=+IBVIENS
  1. . S IBX=$G(^IBCN(365,RSPIEN,0))
  1. . ; IB*702/TAZ,CKB - Set the RSTYPE=REQUESTED SERVICE TYPE CODE (365,.15), and
  1. . ; RSDATE=REQUESTED SERVICE DATE (365,.14)
  1. . ;S TQIEN=$P(IBX,U,5),NODE0=$G(^IBCN(365.1,TQIEN,0)),RSTYPE=$P(NODE0,U,20)
  1. . S RSTYPE=$$GET1^DIQ(365,RSPIEN_",",.15,"I")
  1. . ;S RSDATE=$P($G(^IBCN(365,RSPIEN,1)),U,10) I RSDATE="" S RSDATE=$P(NODE0,U,12)
  1. . S RSDATE=$P($G(^IBCN(365,RSPIEN,1)),U,10) I RSDATE="" S RSDATE=$$GET1^DIQ(365,RSPIEN_",",.14,"I")
  1. . S DFN=+$P(IBX,U,2) ; pt ien
  1. . S INS=+$P(IBX,U,3) ; payer ien
  1. . S INSNM=""
  1. . S PNB=$$PT^IBEFUNC(DFN)
  1. . S PN=$P(PNB,U,1) ; pt name
  1. . S LPID=$P(PNB,U,2) ; pt id
  1. . I INS S INSNM=$P($G(^IBE(365.12,INS,0)),U,1) ; payer name
  1. . S VALMHDR(1)=$$FO^IBCNEUT1(PN,30)_" "_$$FO^IBCNEUT1(LPID,15)_" "_$$FO^IBCNEUT1(INSNM,30)
  1. . 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")_" **"
  1. . Q
  1. ;
  1. I $G(IBBUFDA) D
  1. .N SRVARRAY,Z
  1. .D SERVLN^IBCNBLE(IBBUFDA,.SRVARRAY) I SRVARRAY F Z=1:1:SRVARRAY S VALMHDR(Z+1)=SRVARRAY(Z)
  1. .Q
  1. Q
  1. ;
  1. INIT(IBVF,IBVIENS,IBVEBFLG,IBVV,IBVSUB) ; List Entry
  1. ;
  1. ; IBVF = file# 2.322 or 365.02 (required)
  1. ; IBVIENS = std IENS list of internal entry numbers - NOT including any EB iens (required)
  1. ; IBVEBFLG = flag indicating which EB records to pull
  1. ; "A" - all of them
  1. ; "L" - only the last one (default)
  1. ; "F" - only the first one
  1. ; "M" - multiple, pass IBEBFLG by reference and include the IB iens in
  1. ; an array as follows:
  1. ; IBVEBFLG="M"
  1. ; IBVEBFLG(3)=""
  1. ; IBVEBFLG(5)=""
  1. ; IBVV = Video attributes flag
  1. ; 1 = reverse video (default)
  1. ; 2 = bold
  1. ; 3 = underline
  1. ; IBVSUB = literal subscript to use in the display scratch global
  1. ;
  1. N IBVDA,GLO,IBVLIST,IEN,IBVEBIEN,IBVEBTOT,IBVEBCNT
  1. N IBECODE,IIVSTAT,PLNDESC,IBINSTYP,OTHINS,MWNRIEN ;IB*2.0*506
  1. ;
  1. S OTHINS=0 ;IB*2.0*506/TAZ Initialize Other Insurance variable
  1. S MWNRIEN=$P($G(^IBE(350.9,1,51)),U,25) ;IB*2.0*506/TAZ Initialize Medicare WNR payer IEN
  1. S IBVSUB=$G(IBVSUB)
  1. I IBVSUB="" S IBVSUB="EB ELIG/BEN"
  1. K ^TMP(IBVSUB,$J)
  1. I $D(VALMEVL) D CLEAN^VALM10,KILL^VALM10()
  1. ;
  1. D DA^DILF(IBVIENS,.IBVDA) ; build the IBVDA array for the iens
  1. I '$D(IBVDA) D NODATA G INITX
  1. ;
  1. I $D(VALMEVL),'$G(IBVV) S IBVV=1 ; default reverse video for ListMan
  1. I '$D(VALMEVL) S IBVV="" ; no video attributes for non-ListMan
  1. ;
  1. D RPDM^IBCNES3($S(IBVF=365.02:365,1:2.312),.IBVDA,IBVV,IBVSUB) ; IB*2*497 display group level eligibility information
  1. ;
  1. I IBVF=2.322 S GLO=$NA(^DPT(+$G(IBVDA(1)),.312,+$G(IBVDA),6)) ; pt. insurance
  1. I IBVF=365.02 S GLO=$NA(^IBCN(365,+$G(IBVDA),2)) ; response file
  1. I $G(GLO)="" D NODATA G INITX
  1. ;
  1. S IBVEBFLG=$G(IBVEBFLG,"L")
  1. K IBVLIST
  1. I IBVEBFLG="L" S IEN=+$O(@GLO@(" "),-1) I IEN S IBVLIST(IEN)="" ; last EB ien on file
  1. I IBVEBFLG="F" S IEN=+$O(@GLO@(0)) I IEN S IBVLIST(IEN)="" ; first EB ien on file
  1. I IBVEBFLG="A" S IEN=0 F S IEN=$O(@GLO@(IEN)) Q:'IEN S IBVLIST(IEN)="" ; all EB iens on file
  1. I IBVEBFLG="M" S IEN=0 F S IEN=$O(IBVEBFLG(IEN)) Q:'IEN I $D(@GLO@(IEN)) S IBVLIST(IEN)="" ; multiple
  1. ;
  1. I '$D(IBVLIST) D NODATA G INITX
  1. ;
  1. ; count them
  1. S IEN=0 F IBVEBTOT=0:1 S IEN=$O(IBVLIST(IEN)) Q:'IEN
  1. I 'IBVEBTOT D NODATA G INITX
  1. ;
  1. ; /IB*2.0*506 Beginning
  1. ; Count EBs and gather EB Summary Data
  1. ; IIVSTAT will tell us the coverage status 1,6, or V (File #365.011)
  1. ; Flag related to IBINSTYP will tell us the insurance type (File #365.014)
  1. ; OTHINS will tell us if Other Insurance was indicated on the response
  1. ;
  1. S (IEN,IBVEBTOT,OTHINS)=0,(IIVSTAT,IBINSTYP,PLNDESC)=""
  1. F S IEN=$O(IBVLIST(IEN)) D Q:'IEN
  1. . Q:'IEN
  1. . S IBVEBTOT=IBVEBTOT+1 ; total # of EBs
  1. . I IBVEBTOT=1 D
  1. . . S IBECODE=$P($G(@GLO@(1,0)),U,2) ; Eligibility/Benefits Code
  1. . . S PLNDESC=$P($G(@GLO@(1,0)),U,6) ; Plan Description
  1. . . I PLNDESC'="eIV Eligibility Determination" S IIVSTAT="V"
  1. . . I IBECODE=1 S IIVSTAT=1 ; active
  1. . . I IBECODE=6 S IIVSTAT=6 ; inactive
  1. . . I IIVSTAT="" S IIVSTAT="V" ; ambigious
  1. . . ;
  1. . I IBINSTYP="" D
  1. . . S IBINSTYP=$P($G(@GLO@(IEN,0)),U,5) ; Insurance Type (check all EBs, get 1st occurrence)
  1. . . I IBINSTYP="" Q ; no insurance type found
  1. . . S IBINSTYP=$$GET1^DIQ(365.014,IBINSTYP,.02)
  1. . ;
  1. . ;Screen out non_Medicare records
  1. . S MWNRIEN=$P($G(^IBE(350.9,1,51)),U,25) ; Initialize Medicare WNR payer IEN
  1. . I IBVF=2.322,($$GET1^DIQ(36,$P(^DPT(+$G(IBVDA(1)),.312,+$G(IBVDA),0),U,1)_",",3.1,"I")'=MWNRIEN) Q
  1. . I IBVF=365.02,($P(^IBCN(365,+$G(IBVDA),0),U,3)'=MWNRIEN) Q
  1. . ;
  1. . N IBEIEN,IBELIG
  1. . S IBEIEN=0
  1. . F S IBEIEN=$O(@GLO@(IBEIEN)) Q:'IBEIEN D I OTHINS Q
  1. .. ;Get Eligibility Code. We want R codes only.
  1. .. S IBELIG=$P($G(@GLO@(IBEIEN,0)),U,2) I $P($G(^IBE(365.011,IBELIG,0)),U,1)="R" S OTHINS=1
  1. ;
  1. I IBVEBTOT D SUMMARY(IIVSTAT,IBINSTYP,OTHINS)
  1. ; /IB*2.0*506 End
  1. ;
  1. I 'IBVEBTOT D NODATA G INITX
  1. ;
  1. S (IBVEBIEN,IBVEBCNT)=0
  1. F S IBVEBIEN=$O(IBVLIST(IBVEBIEN)) Q:'IBVEBIEN D
  1. . S IBVEBCNT=IBVEBCNT+1
  1. . N TXVIENS
  1. . ;
  1. . ; if there is more than 1 EB group, then display a header line for separation
  1. . I IBVEBTOT>1 D
  1. .. N DSP,LN,IBZ
  1. .. S DSP=$NA(^TMP(IBVSUB,$J,"DISP"))
  1. .. S LN=+$O(@DSP@(""),-1)
  1. .. S IBZ="eIV Eligibility/Benefit Data Group# "_IBVEBCNT_" of "_IBVEBTOT
  1. .. S IBZ=$$FO^IBCNEUT1($J("",20)_IBZ,80)
  1. .. S LN=LN+1 D SET^IBCNES1(LN,1,IBZ,,IBVV)
  1. .. S LN=LN+1 D SET^IBCNES1(LN)
  1. .. Q
  1. . ;
  1. . ; add this EB ien to the list of iens
  1. . S TXVIENS=IBVEBIEN_","_IBVIENS
  1. . ;
  1. . ; call the screen sections to build the display
  1. . D EB^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
  1. . D CMPI^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
  1. . D HCSD^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
  1. . D NTE^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
  1. . D BRE^IBCNES1(IBVF,TXVIENS,IBVV,IBVSUB)
  1. . ;
  1. . Q
  1. ;
  1. S VALMCNT=$O(^TMP(IBVSUB,$J,"DISP"," "),-1)
  1. ;
  1. INITX ;
  1. Q
  1. ;
  1. SUMMARY(IIVSTAT,IBINSTYP,OTHINS) ; (New w/ IB*2.0*506) key data from the Eligibility Benefit Information
  1. N DSP,LN,IBZ
  1. ;
  1. S IIVSTAT=$S(IIVSTAT=1:"ACTIVE",IIVSTAT=6:"INACTIVE",1:"AMBIGUOUS")
  1. ;
  1. S DSP=$NA(^TMP(IBVSUB,$J,"DISP"))
  1. S LN=+$O(@DSP@(""),-1)
  1. S IBZ="Summary of eIV Eligibility/Benefit Data"
  1. S IBZ=$$FO^IBCNEUT1($J("",20)_IBZ,80)
  1. S LN=LN+1 D SET^IBCNES1(LN,1,IBZ,,IBVV)
  1. S LN=LN+1 D SET^IBCNES1(LN)
  1. ;
  1. S LN=LN+1 D SET^IBCNES1(LN,1,"Coverage Status",IIVSTAT)
  1. S LN=LN+1 D SET^IBCNES1(LN,1,"Insurance Type",IBINSTYP)
  1. ;
  1. I OTHINS S LN=LN+1 D SET^IBCNES1(LN,1,"Other insurance was potentially found")
  1. S LN=LN+1 D SET^IBCNES1(LN)
  1. Q
  1. ;
  1. NODATA ; display no data found
  1. N DSP,LN
  1. S DSP=$NA(^TMP(IBVSUB,$J,"DISP")) ; scratch global display array
  1. S LN=+$O(@DSP@(""),-1) ; last line# used in scratch global
  1. S LN=LN+1 D SET^IBCNES1(LN)
  1. S LN=LN+1 D SET^IBCNES1(LN,5,"No eIV Eligibility/Benefit Data Found")
  1. S VALMCNT=$O(^TMP(IBVSUB,$J,"DISP"," "),-1)
  1. NODATAX ;
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?",VALMANS="??" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K ^TMP(IBVSUB,$J)
  1. I $D(VALMEVL) D CLEAN^VALM10,KILL^VALM10()
  1. Q
  1. ;