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

IBCEPTC2.m

Go to the documentation of this file.
  1. IBCEPTC2 ;ALB/TMK - EDI PREVIOUSLY TRANSMITTED CLAIMS LIST MGR ;01/20/05
  1. ;;2.0;INTEGRATED BILLING;**296,320,348,349,547,592,608**;21-MAR-94;Build 90
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ; IA 3337 for file 430.3
  1. ; IB*2.0*547 Variable IBLOC is pre-defined (in IBCEPTC)
  1. ;
  1. HDR ;
  1. K VALMHDR
  1. ; The following line was replaced by the subsequent couple of lines of code - (vd) IB*2*608 - US1908
  1. ;/IB*2*608 beginning
  1. ; I IBLOC S VALMHDR(1)="Claims Selected: "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" (marked with *)" Q
  1. I IBLOC D Q
  1. . S VALMHDR(1)="** T = Test Claim"
  1. . S VALMHDR(2)="Claims Selected: "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" (marked with *)"
  1. . Q
  1. ;/IB*2*608 ending
  1. ;
  1. S VALMHDR(1)="** A claim may appear multiple times if transmitted more than once. **"
  1. ;
  1. I $G(IBSORT)=1 D
  1. . S VALMHDR(2)="Claims Selected: "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" (marked with *)"
  1. . Q
  1. ;
  1. I $G(IBSORT)=2 D
  1. . S VALMHDR(2)="** T = Test Claim ** R = Batch Rejected"
  1. . S VALMHDR(3)="Claims Selected: "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" (marked with *)"
  1. . Q
  1. ;
  1. Q
  1. ;
  1. INIT ;
  1. S VALMCNT=0,VALMBG=1
  1. D BLD
  1. Q
  1. ;
  1. BLD ; Build display lines
  1. N IBDA,IBS1,IBS2,IBIFN,IB0,IBX,IBCNT,IBLEV1,IBBDA
  1. K ^TMP("IB_PREV_CLAIM_LIST",$J),^TMP("IB_PREV_CLAIM_SELECT",$J),^TMP("IB_PREV_CLAIM_BATCH",$J)
  1. S IBCNT=0
  1. I $O(^TMP("IB_PREV_CLAIM",$J,""))="" D G BLDQ
  1. . S IBX=" ** NO PREVIOUSLY "_$S(IBLOC:"PRINTED",1:"TRANSMITTED")_" CLAIMS EXIST FOR SEARCH CRITERIA SELECTED **"
  1. . D WRT(IBX,"",0,0,"","S","",.IBCNT,0)
  1. ;
  1. S IBS1="" F S IBS1=$O(^TMP("IB_PREV_CLAIM",$J,IBS1)) Q:IBS1="" D
  1. . ; First level sort
  1. . ; for sort by batch, display batch ID and transmit date
  1. . I IBSORT=1 D
  1. .. S IBLEV1=" Batch: "_$P(IBS1,U,2)_" Last Transmitted: "_$G(^TMP("IB_PREV_CLAIM",$J,IBS1))
  1. .. S IBBDA=+$O(^IBA(364.1,"B",$P(IBS1,U,2),0))
  1. .. I $P(IBS1,U,3) S IBLEV1=IBLEV1_" ** Test"
  1. .. I $P(IBS1,U,4) S IBLEV1=IBLEV1_" ** Rejected"
  1. .. Q
  1. . ;
  1. . ; for sort by payer, display ins co name and payer address
  1. . I IBSORT=2 D
  1. .. S IBLEV1=" "_$P(IBS1,U)_" "_$$CURRINS(+$G(^TMP("IB_PREV_CLAIM",$J,IBS1)),0)
  1. .. Q
  1. . ;
  1. . ; output sort header line
  1. . D WRT(IBLEV1,"",0,0,IBSORT,"S","",IBCNT,0) ; Add header line
  1. . ;
  1. . I IBSORT=1,IBBDA S ^TMP("IB_PREV_CLAIM_BATCH",$J,IBBDA)=VALMCNT
  1. . S IBS2="" F S IBS2=$O(^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2)) Q:IBS2="" S IBDA=0 F S IBDA=$O(^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2,IBDA)) Q:'IBDA D
  1. .. N IBX,IBTEST
  1. .. ;S IBIFN=+$G(^IBA(364,+IBDA,0)),IB0=$G(^DGCR(399,IBIFN,0))
  1. .. S IBIFN=$S(IBLOC:+IBDA,1:+$G(^IBA(364,+IBDA,0))),IB0=$G(^DGCR(399,IBIFN,0))
  1. .. S IBX=$P(^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2,IBDA),U,1)
  1. .. I IBX=1 S IBTEST=0 ; live 364 transmission
  1. .. I IBX=2 S IBTEST=1 ; test 364 transmission
  1. .. I IBX=3 S IBTEST=1 ; test 361.4 transmission
  1. .. D WRT(IBS1,IBS2,IBDA,IBIFN,IBSORT,"S","",.IBCNT,0,IBTEST)
  1. .. I IBSORT=1,IBBDA S ^TMP("IB_PREV_CLAIM_BATCH",$J,IBBDA,VALMCNT)=IBIFN_U_IBCNT
  1. .. Q
  1. . Q
  1. ;
  1. BLDQ Q
  1. ;
  1. EXIT ; Clean up code
  1. ;
  1. K ^TMP("IB_PREV_CLAIM_LIST",$J)
  1. K ^TMP("IB_PREV_CLAIM_SELECT",$J)
  1. K ^TMP("IB_PREV_CLAIM_LIST_DX",$J)
  1. K ^TMP("IB_PREV_CLAIM_BATCH",$J)
  1. D CLEAR^VALM1
  1. Q
  1. ;
  1. WRT(IBS1,IBS2,IBDA,IBIFN,IBSORT,IBREP,IBHDR,IBPAGE,IBSTOP,IBTEST) ; Wrt/output
  1. ;
  1. N IBX,IB0,Z,IBCNT,ARSTAT
  1. S IBCNT=IBPAGE
  1. ;
  1. I 'IBIFN D G WRTQ
  1. . ;
  1. . ; for report output
  1. . I IBREP="R" D Q
  1. .. S Z="",$P(Z,"=",133)=""
  1. .. D SET(Z,1,IBDA,IBREP,IBHDR,1,0,.IBPAGE,.IBSTOP)
  1. .. D SET(IBS1,2,IBDA,IBREP,IBHDR,1,0,.IBPAGE,.IBSTOP)
  1. .. Q
  1. . ;
  1. . ; for ListMan screen output
  1. . D SET(IBS1,0,IBDA,IBREP,IBHDR,IBCNT+1,.VALMCNT,.IBPAGE,.IBSTOP)
  1. . Q
  1. ;
  1. S IB0=$G(^DGCR(399,IBIFN,0))
  1. S IBX=$$FO^IBCNEUT1($P(IB0,U,1),8) ; claim#
  1. S IBX=IBX_$S(IBSORT=2&$G(IBTEST):"T",1:" ")_" "
  1. ;JWS;IB*2.0*592 US1108 - Dental EDI 837D / form J430D
  1. S IBX=IBX_$S($P(IB0,U,19)=2:"1500 ",$P(IB0,U,19)=7:"J430D",1:"UB04 ")_" "
  1. S Z=$$INPAT^IBCEF(IBIFN) S IBX=IBX_$S(Z:"INPT ",1:"OUTPT")
  1. S IBX=IBX_$J($P(IB0,U,21),3)_" "
  1. S Z=$$EXTERNAL^DILFD(399,.13,"",$P(IB0,U,13))
  1. S IBX=IBX_$$FO^IBCNEUT1(Z,11)_" " ; claim status
  1. S ARSTAT=+$P($$BILL^RCJIBFN2(IBIFN),U,2) ; ien
  1. S ARSTAT=$P($G(^PRCA(430.3,ARSTAT,0)),U,2) ; abbreviation
  1. S IBX=IBX_$$FO^IBCNEUT1(ARSTAT,4) ; a/r status display
  1. ;
  1. I IBSORT=1 D ; sort by batch
  1. . N Z,IBZ,IBXDATA
  1. . ; Print current payer, payer address, other payers, pat name
  1. . D F^IBCEF("N-CURR INSURANCE COMPANY NAME","IBZ",,IBIFN)
  1. . S IBX=IBX_$$FO^IBCNEUT1(IBZ,25)_" " ; ins co name
  1. . S IBX=IBX_$$FO^IBCNEUT1($$CURRINS(IBIFN,1),29)_" " ; address
  1. . K IBZ D F^IBCEF("N-OTH INSURANCE CO. NAME","IBZ",,IBIFN)
  1. . S IBX=IBX_$$FO^IBCNEUT1($P($G(IBZ(1)),U,1),15)_" " ; other payer
  1. . S Z=$P($G(^DPT(+$P(IB0,U,2),0)),U,1)
  1. . S IBX=IBX_$E(Z,1,18) ; patient name
  1. . ;
  1. . ; set line into list
  1. . S IBCNT=IBCNT+1
  1. . D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
  1. . S IBX=""
  1. . ;
  1. . I $G(IBZ(2))'="" D ; other payer #2 if it exists ;;IB*2.0*592 changed $J("",98) to 99
  1. .. S IBX=$J("",99)_$E($P(IBZ(2),U,1),1,15)
  1. .. D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
  1. .. Q
  1. . Q
  1. ;
  1. I IBSORT=2 D ; sort by payer
  1. . N Z,IBZ
  1. . S IBX=IBX_" "
  1. . ; Print other payers, patient name, date last trans, batch #, reject flag
  1. . D F^IBCEF("N-OTH INSURANCE CO. NAME","IBZ",,IBIFN)
  1. . S IBX=IBX_$$FO^IBCNEUT1($P($G(IBZ(1)),U,1),18)_" " ; oth payer#1
  1. . S Z=$P($G(^DPT(+$P(IB0,U,2),0)),U,1)
  1. . S IBX=IBX_$$FO^IBCNEUT1(Z,18)_" " ; patient name
  1. . ;
  1. . S Z=+$P($G(^IBA(364,+IBDA,0)),U,2) ; Batch ptr
  1. . S:IBLOC IBX=IBX_$$FO^IBCNEUT1($$FMTE^XLFDT($P($G(^DGCR(399,IBIFN,"S")),U,14),"1"),17) ; date last printed *547*
  1. . S:'IBLOC IBX=IBX_$$FO^IBCNEUT1($$FMTE^XLFDT($P($G(^IBA(364.1,+Z,1)),U,3)\1,"1"),17) ; date last transmitted
  1. . S:'IBLOC IBX=IBX_$$FO^IBCNEUT1($P($G(^IBA(364.1,Z,0)),U,1),10) ; batch#
  1. . S:IBLOC IBX=IBX_"" ; no batch#
  1. . S IBX=IBX_$S($P($G(^IBA(364.1,Z,0)),U,5):" R",1:"") ; batch rejected flag
  1. . ;
  1. . ; set line into list
  1. . S IBCNT=IBCNT+1
  1. . D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
  1. . S IBX=""
  1. . ;
  1. . I $G(IBZ(2))'="" D ; other payer#2 if it exists
  1. .. S IBX=$J("",45)_$E($P(IBZ(2),U),1,18)
  1. .. D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
  1. .. Q
  1. . Q
  1. ;
  1. WRTQ I IBREP="S" S IBPAGE=IBCNT
  1. Q
  1. ;
  1. SET(IBX,IBLINE,IBDA,IBREP,IBHDR,IBCNT,VALMCNT,IBPAGE,IBSTOP) ;
  1. N Q,Z,IBZ
  1. S IBZ=IBX,IBX=""
  1. I IBREP="R" D Q
  1. . D:($Y+5)>IOSL!'IBPAGE HDR^IBCEPTC1(IBHDR,IBSORT,.IBPAGE,.IBSTOP) D
  1. . I IBLINE F Z=1:1:IBLINE W !
  1. . W:'IBSTOP IBZ
  1. . Q
  1. ;
  1. ; only display the counter if we have a line with the claim#
  1. S VALMCNT=VALMCNT+1
  1. I IBDA,$TR($E(IBZ,1,8)," ")'="" S IBZ=$$FO^IBCNEUT1($J(IBCNT,3),6)_IBZ
  1. I IBDA,$TR($E(IBZ,1,8)," ")="" S IBZ=" "_IBZ
  1. ;
  1. S ^TMP("IB_PREV_CLAIM_LIST",$J,VALMCNT,0)=IBZ
  1. S ^TMP("IB_PREV_CLAIM_LIST",$J,"IDX",VALMCNT,IBCNT)=""
  1. I IBDA,$TR($E(IBZ,1,8)," ")'="" S ^TMP("IB_PREV_CLAIM_LIST_DX",$J,IBCNT)=VALMCNT_U_IBDA
  1. Q
  1. ;
  1. CURRINS(IBIFN,TRUNC) ; Returns Current insurance address for given claim
  1. ; TRUNC = truncate flag; 1 to truncate the address and city
  1. N IBX,IBZ,L1,CITY,ST
  1. D F^IBCEF("N-CURR INS CO FULL ADDRESS","IBZ",,IBIFN)
  1. S L1=$G(IBZ(1)) I +$G(TRUNC) S L1=$E(L1,1,15)
  1. S CITY=$G(IBZ(4)) I +$G(TRUNC) S CITY=$E(CITY,1,10)
  1. S ST=$G(IBZ(5))
  1. I ST S ST=$P($G(^DIC(5,ST,0)),U,2)
  1. S IBX=L1_" "_CITY
  1. I CITY'="",ST'="" S IBX=IBX_","_ST
  1. E S IBX=IBX_" "_ST
  1. Q IBX
  1. ;