IBCEPTC2 ;ALB/TMK - EDI PREVIOUSLY TRANSMITTED CLAIMS LIST MGR ;01/20/05
;;2.0;INTEGRATED BILLING;**296,320,348,349,547,592,608**;21-MAR-94;Build 90
;;Per VA Directive 6402, this routine should not be modified.
; IA 3337 for file 430.3
; IB*2.0*547 Variable IBLOC is pre-defined (in IBCEPTC)
;
HDR ;
K VALMHDR
; The following line was replaced by the subsequent couple of lines of code - (vd) IB*2*608 - US1908
;/IB*2*608 beginning
; I IBLOC S VALMHDR(1)="Claims Selected: "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" (marked with *)" Q
I IBLOC D Q
. S VALMHDR(1)="** T = Test Claim"
. S VALMHDR(2)="Claims Selected: "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" (marked with *)"
. Q
;/IB*2*608 ending
;
S VALMHDR(1)="** A claim may appear multiple times if transmitted more than once. **"
;
I $G(IBSORT)=1 D
. S VALMHDR(2)="Claims Selected: "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" (marked with *)"
. Q
;
I $G(IBSORT)=2 D
. S VALMHDR(2)="** T = Test Claim ** R = Batch Rejected"
. S VALMHDR(3)="Claims Selected: "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" (marked with *)"
. Q
;
Q
;
INIT ;
S VALMCNT=0,VALMBG=1
D BLD
Q
;
BLD ; Build display lines
N IBDA,IBS1,IBS2,IBIFN,IB0,IBX,IBCNT,IBLEV1,IBBDA
K ^TMP("IB_PREV_CLAIM_LIST",$J),^TMP("IB_PREV_CLAIM_SELECT",$J),^TMP("IB_PREV_CLAIM_BATCH",$J)
S IBCNT=0
I $O(^TMP("IB_PREV_CLAIM",$J,""))="" D G BLDQ
. S IBX=" ** NO PREVIOUSLY "_$S(IBLOC:"PRINTED",1:"TRANSMITTED")_" CLAIMS EXIST FOR SEARCH CRITERIA SELECTED **"
. D WRT(IBX,"",0,0,"","S","",.IBCNT,0)
;
S IBS1="" F S IBS1=$O(^TMP("IB_PREV_CLAIM",$J,IBS1)) Q:IBS1="" D
. ; First level sort
. ; for sort by batch, display batch ID and transmit date
. I IBSORT=1 D
.. S IBLEV1=" Batch: "_$P(IBS1,U,2)_" Last Transmitted: "_$G(^TMP("IB_PREV_CLAIM",$J,IBS1))
.. S IBBDA=+$O(^IBA(364.1,"B",$P(IBS1,U,2),0))
.. I $P(IBS1,U,3) S IBLEV1=IBLEV1_" ** Test"
.. I $P(IBS1,U,4) S IBLEV1=IBLEV1_" ** Rejected"
.. Q
. ;
. ; for sort by payer, display ins co name and payer address
. I IBSORT=2 D
.. S IBLEV1=" "_$P(IBS1,U)_" "_$$CURRINS(+$G(^TMP("IB_PREV_CLAIM",$J,IBS1)),0)
.. Q
. ;
. ; output sort header line
. D WRT(IBLEV1,"",0,0,IBSORT,"S","",IBCNT,0) ; Add header line
. ;
. I IBSORT=1,IBBDA S ^TMP("IB_PREV_CLAIM_BATCH",$J,IBBDA)=VALMCNT
. 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
.. N IBX,IBTEST
.. ;S IBIFN=+$G(^IBA(364,+IBDA,0)),IB0=$G(^DGCR(399,IBIFN,0))
.. S IBIFN=$S(IBLOC:+IBDA,1:+$G(^IBA(364,+IBDA,0))),IB0=$G(^DGCR(399,IBIFN,0))
.. S IBX=$P(^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2,IBDA),U,1)
.. I IBX=1 S IBTEST=0 ; live 364 transmission
.. I IBX=2 S IBTEST=1 ; test 364 transmission
.. I IBX=3 S IBTEST=1 ; test 361.4 transmission
.. D WRT(IBS1,IBS2,IBDA,IBIFN,IBSORT,"S","",.IBCNT,0,IBTEST)
.. I IBSORT=1,IBBDA S ^TMP("IB_PREV_CLAIM_BATCH",$J,IBBDA,VALMCNT)=IBIFN_U_IBCNT
.. Q
. Q
;
BLDQ Q
;
EXIT ; Clean up code
;
K ^TMP("IB_PREV_CLAIM_LIST",$J)
K ^TMP("IB_PREV_CLAIM_SELECT",$J)
K ^TMP("IB_PREV_CLAIM_LIST_DX",$J)
K ^TMP("IB_PREV_CLAIM_BATCH",$J)
D CLEAR^VALM1
Q
;
WRT(IBS1,IBS2,IBDA,IBIFN,IBSORT,IBREP,IBHDR,IBPAGE,IBSTOP,IBTEST) ; Wrt/output
;
N IBX,IB0,Z,IBCNT,ARSTAT
S IBCNT=IBPAGE
;
I 'IBIFN D G WRTQ
. ;
. ; for report output
. I IBREP="R" D Q
.. S Z="",$P(Z,"=",133)=""
.. D SET(Z,1,IBDA,IBREP,IBHDR,1,0,.IBPAGE,.IBSTOP)
.. D SET(IBS1,2,IBDA,IBREP,IBHDR,1,0,.IBPAGE,.IBSTOP)
.. Q
. ;
. ; for ListMan screen output
. D SET(IBS1,0,IBDA,IBREP,IBHDR,IBCNT+1,.VALMCNT,.IBPAGE,.IBSTOP)
. Q
;
S IB0=$G(^DGCR(399,IBIFN,0))
S IBX=$$FO^IBCNEUT1($P(IB0,U,1),8) ; claim#
S IBX=IBX_$S(IBSORT=2&$G(IBTEST):"T",1:" ")_" "
;JWS;IB*2.0*592 US1108 - Dental EDI 837D / form J430D
S IBX=IBX_$S($P(IB0,U,19)=2:"1500 ",$P(IB0,U,19)=7:"J430D",1:"UB04 ")_" "
S Z=$$INPAT^IBCEF(IBIFN) S IBX=IBX_$S(Z:"INPT ",1:"OUTPT")
S IBX=IBX_$J($P(IB0,U,21),3)_" "
S Z=$$EXTERNAL^DILFD(399,.13,"",$P(IB0,U,13))
S IBX=IBX_$$FO^IBCNEUT1(Z,11)_" " ; claim status
S ARSTAT=+$P($$BILL^RCJIBFN2(IBIFN),U,2) ; ien
S ARSTAT=$P($G(^PRCA(430.3,ARSTAT,0)),U,2) ; abbreviation
S IBX=IBX_$$FO^IBCNEUT1(ARSTAT,4) ; a/r status display
;
I IBSORT=1 D ; sort by batch
. N Z,IBZ,IBXDATA
. ; Print current payer, payer address, other payers, pat name
. D F^IBCEF("N-CURR INSURANCE COMPANY NAME","IBZ",,IBIFN)
. S IBX=IBX_$$FO^IBCNEUT1(IBZ,25)_" " ; ins co name
. S IBX=IBX_$$FO^IBCNEUT1($$CURRINS(IBIFN,1),29)_" " ; address
. K IBZ D F^IBCEF("N-OTH INSURANCE CO. NAME","IBZ",,IBIFN)
. S IBX=IBX_$$FO^IBCNEUT1($P($G(IBZ(1)),U,1),15)_" " ; other payer
. S Z=$P($G(^DPT(+$P(IB0,U,2),0)),U,1)
. S IBX=IBX_$E(Z,1,18) ; patient name
. ;
. ; set line into list
. S IBCNT=IBCNT+1
. D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
. S IBX=""
. ;
. I $G(IBZ(2))'="" D ; other payer #2 if it exists ;;IB*2.0*592 changed $J("",98) to 99
.. S IBX=$J("",99)_$E($P(IBZ(2),U,1),1,15)
.. D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
.. Q
. Q
;
I IBSORT=2 D ; sort by payer
. N Z,IBZ
. S IBX=IBX_" "
. ; Print other payers, patient name, date last trans, batch #, reject flag
. D F^IBCEF("N-OTH INSURANCE CO. NAME","IBZ",,IBIFN)
. S IBX=IBX_$$FO^IBCNEUT1($P($G(IBZ(1)),U,1),18)_" " ; oth payer#1
. S Z=$P($G(^DPT(+$P(IB0,U,2),0)),U,1)
. S IBX=IBX_$$FO^IBCNEUT1(Z,18)_" " ; patient name
. ;
. S Z=+$P($G(^IBA(364,+IBDA,0)),U,2) ; Batch ptr
. S:IBLOC IBX=IBX_$$FO^IBCNEUT1($$FMTE^XLFDT($P($G(^DGCR(399,IBIFN,"S")),U,14),"1"),17) ; date last printed *547*
. S:'IBLOC IBX=IBX_$$FO^IBCNEUT1($$FMTE^XLFDT($P($G(^IBA(364.1,+Z,1)),U,3)\1,"1"),17) ; date last transmitted
. S:'IBLOC IBX=IBX_$$FO^IBCNEUT1($P($G(^IBA(364.1,Z,0)),U,1),10) ; batch#
. S:IBLOC IBX=IBX_"" ; no batch#
. S IBX=IBX_$S($P($G(^IBA(364.1,Z,0)),U,5):" R",1:"") ; batch rejected flag
. ;
. ; set line into list
. S IBCNT=IBCNT+1
. D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
. S IBX=""
. ;
. I $G(IBZ(2))'="" D ; other payer#2 if it exists
.. S IBX=$J("",45)_$E($P(IBZ(2),U),1,18)
.. D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
.. Q
. Q
;
WRTQ I IBREP="S" S IBPAGE=IBCNT
Q
;
SET(IBX,IBLINE,IBDA,IBREP,IBHDR,IBCNT,VALMCNT,IBPAGE,IBSTOP) ;
N Q,Z,IBZ
S IBZ=IBX,IBX=""
I IBREP="R" D Q
. D:($Y+5)>IOSL!'IBPAGE HDR^IBCEPTC1(IBHDR,IBSORT,.IBPAGE,.IBSTOP) D
. I IBLINE F Z=1:1:IBLINE W !
. W:'IBSTOP IBZ
. Q
;
; only display the counter if we have a line with the claim#
S VALMCNT=VALMCNT+1
I IBDA,$TR($E(IBZ,1,8)," ")'="" S IBZ=$$FO^IBCNEUT1($J(IBCNT,3),6)_IBZ
I IBDA,$TR($E(IBZ,1,8)," ")="" S IBZ=" "_IBZ
;
S ^TMP("IB_PREV_CLAIM_LIST",$J,VALMCNT,0)=IBZ
S ^TMP("IB_PREV_CLAIM_LIST",$J,"IDX",VALMCNT,IBCNT)=""
I IBDA,$TR($E(IBZ,1,8)," ")'="" S ^TMP("IB_PREV_CLAIM_LIST_DX",$J,IBCNT)=VALMCNT_U_IBDA
Q
;
CURRINS(IBIFN,TRUNC) ; Returns Current insurance address for given claim
; TRUNC = truncate flag; 1 to truncate the address and city
N IBX,IBZ,L1,CITY,ST
D F^IBCEF("N-CURR INS CO FULL ADDRESS","IBZ",,IBIFN)
S L1=$G(IBZ(1)) I +$G(TRUNC) S L1=$E(L1,1,15)
S CITY=$G(IBZ(4)) I +$G(TRUNC) S CITY=$E(CITY,1,10)
S ST=$G(IBZ(5))
I ST S ST=$P($G(^DIC(5,ST,0)),U,2)
S IBX=L1_" "_CITY
I CITY'="",ST'="" S IBX=IBX_","_ST
E S IBX=IBX_" "_ST
Q IBX
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEPTC2 7680 printed Dec 13, 2024@02:12:04 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ; IA 3337 for file 430.3
+4 ; IB*2.0*547 Variable IBLOC is pre-defined (in IBCEPTC)
+5 ;
HDR ;
+1 KILL VALMHDR
+2 ; The following line was replaced by the subsequent couple of lines of code - (vd) IB*2*608 - US1908
+3 ;/IB*2*608 beginning
+4 ; I IBLOC S VALMHDR(1)="Claims Selected: "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" (marked with *)" Q
+5 IF IBLOC
Begin DoDot:1
+6 SET VALMHDR(1)="** T = Test Claim"
+7 SET VALMHDR(2)="Claims Selected: "_+$GET(^TMP("IB_PREV_CLAIM_SELECT",$JOB))_" (marked with *)"
+8 QUIT
End DoDot:1
QUIT
+9 ;/IB*2*608 ending
+10 ;
+11 SET VALMHDR(1)="** A claim may appear multiple times if transmitted more than once. **"
+12 ;
+13 IF $GET(IBSORT)=1
Begin DoDot:1
+14 SET VALMHDR(2)="Claims Selected: "_+$GET(^TMP("IB_PREV_CLAIM_SELECT",$JOB))_" (marked with *)"
+15 QUIT
End DoDot:1
+16 ;
+17 IF $GET(IBSORT)=2
Begin DoDot:1
+18 SET VALMHDR(2)="** T = Test Claim ** R = Batch Rejected"
+19 SET VALMHDR(3)="Claims Selected: "_+$GET(^TMP("IB_PREV_CLAIM_SELECT",$JOB))_" (marked with *)"
+20 QUIT
End DoDot:1
+21 ;
+22 QUIT
+23 ;
INIT ;
+1 SET VALMCNT=0
SET VALMBG=1
+2 DO BLD
+3 QUIT
+4 ;
BLD ; Build display lines
+1 NEW IBDA,IBS1,IBS2,IBIFN,IB0,IBX,IBCNT,IBLEV1,IBBDA
+2 KILL ^TMP("IB_PREV_CLAIM_LIST",$JOB),^TMP("IB_PREV_CLAIM_SELECT",$JOB),^TMP("IB_PREV_CLAIM_BATCH",$JOB)
+3 SET IBCNT=0
+4 IF $ORDER(^TMP("IB_PREV_CLAIM",$JOB,""))=""
Begin DoDot:1
+5 SET IBX=" ** NO PREVIOUSLY "_$SELECT(IBLOC:"PRINTED",1:"TRANSMITTED")_" CLAIMS EXIST FOR SEARCH CRITERIA SELECTED **"
+6 DO WRT(IBX,"",0,0,"","S","",.IBCNT,0)
End DoDot:1
GOTO BLDQ
+7 ;
+8 SET IBS1=""
FOR
SET IBS1=$ORDER(^TMP("IB_PREV_CLAIM",$JOB,IBS1))
if IBS1=""
QUIT
Begin DoDot:1
+9 ; First level sort
+10 ; for sort by batch, display batch ID and transmit date
+11 IF IBSORT=1
Begin DoDot:2
+12 SET IBLEV1=" Batch: "_$PIECE(IBS1,U,2)_" Last Transmitted: "_$GET(^TMP("IB_PREV_CLAIM",$JOB,IBS1))
+13 SET IBBDA=+$ORDER(^IBA(364.1,"B",$PIECE(IBS1,U,2),0))
+14 IF $PIECE(IBS1,U,3)
SET IBLEV1=IBLEV1_" ** Test"
+15 IF $PIECE(IBS1,U,4)
SET IBLEV1=IBLEV1_" ** Rejected"
+16 QUIT
End DoDot:2
+17 ;
+18 ; for sort by payer, display ins co name and payer address
+19 IF IBSORT=2
Begin DoDot:2
+20 SET IBLEV1=" "_$PIECE(IBS1,U)_" "_$$CURRINS(+$GET(^TMP("IB_PREV_CLAIM",$JOB,IBS1)),0)
+21 QUIT
End DoDot:2
+22 ;
+23 ; output sort header line
+24 ; Add header line
DO WRT(IBLEV1,"",0,0,IBSORT,"S","",IBCNT,0)
+25 ;
+26 IF IBSORT=1
IF IBBDA
SET ^TMP("IB_PREV_CLAIM_BATCH",$JOB,IBBDA)=VALMCNT
+27 SET IBS2=""
FOR
SET IBS2=$ORDER(^TMP("IB_PREV_CLAIM",$JOB,IBS1,IBS2))
if IBS2=""
QUIT
SET IBDA=0
FOR
SET IBDA=$ORDER(^TMP("IB_PREV_CLAIM",$JOB,IBS1,IBS2,IBDA))
if 'IBDA
QUIT
Begin DoDot:2
+28 NEW IBX,IBTEST
+29 ;S IBIFN=+$G(^IBA(364,+IBDA,0)),IB0=$G(^DGCR(399,IBIFN,0))
+30 SET IBIFN=$SELECT(IBLOC:+IBDA,1:+$GET(^IBA(364,+IBDA,0)))
SET IB0=$GET(^DGCR(399,IBIFN,0))
+31 SET IBX=$PIECE(^TMP("IB_PREV_CLAIM",$JOB,IBS1,IBS2,IBDA),U,1)
+32 ; live 364 transmission
IF IBX=1
SET IBTEST=0
+33 ; test 364 transmission
IF IBX=2
SET IBTEST=1
+34 ; test 361.4 transmission
IF IBX=3
SET IBTEST=1
+35 DO WRT(IBS1,IBS2,IBDA,IBIFN,IBSORT,"S","",.IBCNT,0,IBTEST)
+36 IF IBSORT=1
IF IBBDA
SET ^TMP("IB_PREV_CLAIM_BATCH",$JOB,IBBDA,VALMCNT)=IBIFN_U_IBCNT
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
+39 ;
BLDQ QUIT
+1 ;
EXIT ; Clean up code
+1 ;
+2 KILL ^TMP("IB_PREV_CLAIM_LIST",$JOB)
+3 KILL ^TMP("IB_PREV_CLAIM_SELECT",$JOB)
+4 KILL ^TMP("IB_PREV_CLAIM_LIST_DX",$JOB)
+5 KILL ^TMP("IB_PREV_CLAIM_BATCH",$JOB)
+6 DO CLEAR^VALM1
+7 QUIT
+8 ;
WRT(IBS1,IBS2,IBDA,IBIFN,IBSORT,IBREP,IBHDR,IBPAGE,IBSTOP,IBTEST) ; Wrt/output
+1 ;
+2 NEW IBX,IB0,Z,IBCNT,ARSTAT
+3 SET IBCNT=IBPAGE
+4 ;
+5 IF 'IBIFN
Begin DoDot:1
+6 ;
+7 ; for report output
+8 IF IBREP="R"
Begin DoDot:2
+9 SET Z=""
SET $PIECE(Z,"=",133)=""
+10 DO SET(Z,1,IBDA,IBREP,IBHDR,1,0,.IBPAGE,.IBSTOP)
+11 DO SET(IBS1,2,IBDA,IBREP,IBHDR,1,0,.IBPAGE,.IBSTOP)
+12 QUIT
End DoDot:2
QUIT
+13 ;
+14 ; for ListMan screen output
+15 DO SET(IBS1,0,IBDA,IBREP,IBHDR,IBCNT+1,.VALMCNT,.IBPAGE,.IBSTOP)
+16 QUIT
End DoDot:1
GOTO WRTQ
+17 ;
+18 SET IB0=$GET(^DGCR(399,IBIFN,0))
+19 ; claim#
SET IBX=$$FO^IBCNEUT1($PIECE(IB0,U,1),8)
+20 SET IBX=IBX_$SELECT(IBSORT=2&$GET(IBTEST):"T",1:" ")_" "
+21 ;JWS;IB*2.0*592 US1108 - Dental EDI 837D / form J430D
+22 SET IBX=IBX_$SELECT($PIECE(IB0,U,19)=2:"1500 ",$PIECE(IB0,U,19)=7:"J430D",1:"UB04 ")_" "
+23 SET Z=$$INPAT^IBCEF(IBIFN)
SET IBX=IBX_$SELECT(Z:"INPT ",1:"OUTPT")
+24 SET IBX=IBX_$JUSTIFY($PIECE(IB0,U,21),3)_" "
+25 SET Z=$$EXTERNAL^DILFD(399,.13,"",$PIECE(IB0,U,13))
+26 ; claim status
SET IBX=IBX_$$FO^IBCNEUT1(Z,11)_" "
+27 ; ien
SET ARSTAT=+$PIECE($$BILL^RCJIBFN2(IBIFN),U,2)
+28 ; abbreviation
SET ARSTAT=$PIECE($GET(^PRCA(430.3,ARSTAT,0)),U,2)
+29 ; a/r status display
SET IBX=IBX_$$FO^IBCNEUT1(ARSTAT,4)
+30 ;
+31 ; sort by batch
IF IBSORT=1
Begin DoDot:1
+32 NEW Z,IBZ,IBXDATA
+33 ; Print current payer, payer address, other payers, pat name
+34 DO F^IBCEF("N-CURR INSURANCE COMPANY NAME","IBZ",,IBIFN)
+35 ; ins co name
SET IBX=IBX_$$FO^IBCNEUT1(IBZ,25)_" "
+36 ; address
SET IBX=IBX_$$FO^IBCNEUT1($$CURRINS(IBIFN,1),29)_" "
+37 KILL IBZ
DO F^IBCEF("N-OTH INSURANCE CO. NAME","IBZ",,IBIFN)
+38 ; other payer
SET IBX=IBX_$$FO^IBCNEUT1($PIECE($GET(IBZ(1)),U,1),15)_" "
+39 SET Z=$PIECE($GET(^DPT(+$PIECE(IB0,U,2),0)),U,1)
+40 ; patient name
SET IBX=IBX_$EXTRACT(Z,1,18)
+41 ;
+42 ; set line into list
+43 SET IBCNT=IBCNT+1
+44 DO SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
+45 SET IBX=""
+46 ;
+47 ; other payer #2 if it exists ;;IB*2.0*592 changed $J("",98) to 99
IF $GET(IBZ(2))'=""
Begin DoDot:2
+48 SET IBX=$JUSTIFY("",99)_$EXTRACT($PIECE(IBZ(2),U,1),1,15)
+49 DO SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
+50 QUIT
End DoDot:2
+51 QUIT
End DoDot:1
+52 ;
+53 ; sort by payer
IF IBSORT=2
Begin DoDot:1
+54 NEW Z,IBZ
+55 SET IBX=IBX_" "
+56 ; Print other payers, patient name, date last trans, batch #, reject flag
+57 DO F^IBCEF("N-OTH INSURANCE CO. NAME","IBZ",,IBIFN)
+58 ; oth payer#1
SET IBX=IBX_$$FO^IBCNEUT1($PIECE($GET(IBZ(1)),U,1),18)_" "
+59 SET Z=$PIECE($GET(^DPT(+$PIECE(IB0,U,2),0)),U,1)
+60 ; patient name
SET IBX=IBX_$$FO^IBCNEUT1(Z,18)_" "
+61 ;
+62 ; Batch ptr
SET Z=+$PIECE($GET(^IBA(364,+IBDA,0)),U,2)
+63 ; date last printed *547*
if IBLOC
SET IBX=IBX_$$FO^IBCNEUT1($$FMTE^XLFDT($PIECE($GET(^DGCR(399,IBIFN,"S")),U,14),"1"),17)
+64 ; date last transmitted
if 'IBLOC
SET IBX=IBX_$$FO^IBCNEUT1($$FMTE^XLFDT($PIECE($GET(^IBA(364.1,+Z,1)),U,3)\1,"1"),17)
+65 ; batch#
if 'IBLOC
SET IBX=IBX_$$FO^IBCNEUT1($PIECE($GET(^IBA(364.1,Z,0)),U,1),10)
+66 ; no batch#
if IBLOC
SET IBX=IBX_""
+67 ; batch rejected flag
SET IBX=IBX_$SELECT($PIECE($GET(^IBA(364.1,Z,0)),U,5):" R",1:"")
+68 ;
+69 ; set line into list
+70 SET IBCNT=IBCNT+1
+71 DO SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
+72 SET IBX=""
+73 ;
+74 ; other payer#2 if it exists
IF $GET(IBZ(2))'=""
Begin DoDot:2
+75 SET IBX=$JUSTIFY("",45)_$EXTRACT($PIECE(IBZ(2),U),1,18)
+76 DO SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
+77 QUIT
End DoDot:2
+78 QUIT
End DoDot:1
+79 ;
WRTQ IF IBREP="S"
SET IBPAGE=IBCNT
+1 QUIT
+2 ;
SET(IBX,IBLINE,IBDA,IBREP,IBHDR,IBCNT,VALMCNT,IBPAGE,IBSTOP) ;
+1 NEW Q,Z,IBZ
+2 SET IBZ=IBX
SET IBX=""
+3 IF IBREP="R"
Begin DoDot:1
+4 if ($Y+5)>IOSL!'IBPAGE
DO HDR^IBCEPTC1(IBHDR,IBSORT,.IBPAGE,.IBSTOP)
Begin DoDot:2
End DoDot:2
+5 IF IBLINE
FOR Z=1:1:IBLINE
WRITE !
+6 if 'IBSTOP
WRITE IBZ
+7 QUIT
End DoDot:1
QUIT
+8 ;
+9 ; only display the counter if we have a line with the claim#
+10 SET VALMCNT=VALMCNT+1
+11 IF IBDA
IF $TRANSLATE($EXTRACT(IBZ,1,8)," ")'=""
SET IBZ=$$FO^IBCNEUT1($JUSTIFY(IBCNT,3),6)_IBZ
+12 IF IBDA
IF $TRANSLATE($EXTRACT(IBZ,1,8)," ")=""
SET IBZ=" "_IBZ
+13 ;
+14 SET ^TMP("IB_PREV_CLAIM_LIST",$JOB,VALMCNT,0)=IBZ
+15 SET ^TMP("IB_PREV_CLAIM_LIST",$JOB,"IDX",VALMCNT,IBCNT)=""
+16 IF IBDA
IF $TRANSLATE($EXTRACT(IBZ,1,8)," ")'=""
SET ^TMP("IB_PREV_CLAIM_LIST_DX",$JOB,IBCNT)=VALMCNT_U_IBDA
+17 QUIT
+18 ;
CURRINS(IBIFN,TRUNC) ; Returns Current insurance address for given claim
+1 ; TRUNC = truncate flag; 1 to truncate the address and city
+2 NEW IBX,IBZ,L1,CITY,ST
+3 DO F^IBCEF("N-CURR INS CO FULL ADDRESS","IBZ",,IBIFN)
+4 SET L1=$GET(IBZ(1))
IF +$GET(TRUNC)
SET L1=$EXTRACT(L1,1,15)
+5 SET CITY=$GET(IBZ(4))
IF +$GET(TRUNC)
SET CITY=$EXTRACT(CITY,1,10)
+6 SET ST=$GET(IBZ(5))
+7 IF ST
SET ST=$PIECE($GET(^DIC(5,ST,0)),U,2)
+8 SET IBX=L1_" "_CITY
+9 IF CITY'=""
IF ST'=""
SET IBX=IBX_","_ST
+10 IF '$TEST
SET IBX=IBX_" "_ST
+11 QUIT IBX
+12 ;
