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

IBY727PO.m

Go to the documentation of this file. 
  1. IBY727PO ;EDE/TPF - POST INSTALL ROUTINE FOR IB*2.0*727
  1.  ;;2.0;INTEGRATED BILLING;**727**;;Build 34
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. POST ;EP - POST INSTALL TO REMOVE EOB CLAIMS WITH MSE ERRORS FROM WORKLIST
  1.  Q:(($P($$SITE^VASITE,U,3)=683)!(($P($$SITE^VASITE,U,3)=684)))&'($$PROD^XUPROD(1))
  1.  N IBIENS,IBFDA,IBIFN
  1.  S IBIFN=0
  1.  F  S IBIFN=$O(^DGCR(399,"CAP",1,IBIFN)) Q:'IBIFN  D
  1.  .;Q:'($$GET1^DIQ(399,IBIFN_",",36,"","","")="IB803")  ;TPF;EBILL-;IB*2.0*727 V14
  1.  .Q:$$MELG(IBIFN,1)                    ;IF TRUE CLAIM SHOULD BE ON THE WORKLIST;TPF;EBILL-3054;IB*2.0*727 v15
  1.  .S X=$$WLRMVF^IBCECOB1(IBIFN,"RM",1)
  1.  Q
  1.  ;
  1.  ;This is the original MELG without the quit commented out in p727
  1. MELG(IBIFN,IBMRADUP) ; function to check all EOBs for a claim and determine if they are
  1.  ; eligible for inclusion on the COB management worklist, uses both B & C x-ref
  1.  ; IBIFN - claim ien (required)
  1.  ; IBMRADUP - indicates user said NO to "include denied for duplicate" prompt
  1.  ;
  1.  ; Returns EOB ien to use for display, if at least 1 EOB passed all checks
  1.  ; if multiple EOBs passed but some have filing errors, returns the 1st EOB found that does NOT have filing errors
  1.  ; if all EOBs have filing errors, tries to find one that is a PROCESSED status and return that one for CBW display
  1.  ; Returns -1 if claim should appear on the worklist with no EOB
  1.  ; Returns 0 if no EOBs passed the checks and claim should not appear on the worklist, also removes it
  1.  ;
  1.  ; IBCK = Total number of EOBs found for this claim ien
  1.  ; IBECT = Total number of EOBs that failed the EOB TYPE check
  1.  ; IBCT = Total number of EOBs for a claim that passed ALL the checks
  1.  ;
  1.  N IBDA,IBCT,IBEOBNDX,IBEOB,IB3611,IBCK,IBETC
  1.  S IBCT=0,IBCK=0,IBETC=0
  1.  F IBEOBNDX="B","C" D
  1.  .S IBDA=0 F  S IBDA=$O(^IBM(361.1,IBEOBNDX,IBIFN,IBDA)) Q:'+IBDA  D
  1.  ..Q:$D(IBEOB(IBDA))
  1.  ..S IB3611=$G(^IBM(361.1,IBDA,0)),IBCK=IBCK+1
  1.  ..Q:$D(^IBM(361.1,IBDA,"ERR"))    ;TPF;EBILL-3054;IB*2.0*727 v15
  1.  ..; if this is a denied EOB and user does NOT want to include denied as duplicates and this EOB was denied as duplicate, don't include
  1.  ..I $P(IB3611,U,13)=2,'$G(IBMRADUP),$$DENDUP^IBCEMU4(IBDA,1) Q
  1.  ..; eob type must be correct for this worklist
  1.  ..I $P(IB3611,U,4)=1 S IBETC=IBETC+1 Q
  1.  ..; allow filing errors on worklist, but try to find at least 1 Processed EOB w/out errors
  1.  ..I $D(^IBM(361.1,IBDA,"ERR")) S:$P($G(^IBM(361.1,IBDA,0)),U,13)'=1 IBEOB("DER",IBDA)="" S:$P($G(^IBM(361.1,IBDA,0)),U,13)=1 IBEOB("PER",IBDA)="" Q
  1.  ..S IBEOB(IBDA)="",IBCT=IBCT+1
  1.  ; if no EOB was found to check, return -1 to process as no EOB
  1.  Q:IBCK=0 -1
  1.  ; if no EOB passed, check to see if the EOBs were all MRA primaries that failed the EOB type check (2ndary/tertiaries were paper)
  1.  I IBCT=0,$$WNRBILL^IBEFUNC(IBIFN,1),$$COBN^IBCEF(IBIFN)>1,(IBCK=IBETC) Q -1
  1.  ; if no EOB's passed, check for filing errors and use that EOB, with Processed EOB's taking priority over denied
  1.  I IBCT=0,$D(IBEOB("PER")) Q $O(IBEOB("PER",0))
  1.  I IBCT=0,$D(IBEOB("DER")) Q $O(IBEOB("DER",0))
  1.  ; if no EOB passed and not MRA primary w/subsequent paper EOB's or filing errors, do not put on CBW
  1.  Q:IBCT=0 0
  1.  ; if one or more EOBs passed, return the 1st one that passed the checks as the one to use for CBW display
  1.  Q $O(IBEOB(0))