IBCECSA1 ;ALB/CXW - IB STATUS AWAITING RESOLUTION SCREEN ;28-JUL-99
;;2.0;INTEGRATED BILLING;**137,283,288,320,368,623,650**;21-MAR-94;Build 21
;;Per VA Directive 6402, this routine should not be modified.
; DBIA for $$BN1^PRCAFN()
;
BLD ; Build list entrypoint
;N IBDA,IBREV,IBIFN,IBPAY,IBSSN,IBSER,IB399,IBLOC,IBDIV,IBUER,IBMSG,IBERR,IBPEN,SEVERITY,A,IBOAM,IBPAT,IBSTSMSG,SV1,SV2,SV3
N A,IB399,IBDA,IBDIV,IBERR,IBIFN,IBLOC,IBMCCF,IBMSG,IBNON,IBOAM,IBPAT,IBPAY,IBPEN ;/vd-IB*2.0*623 (US141) - Reordered variables
N IBREV,IBRTYP,IBSER,IBSSN,IBSTSMSG,IBUER,SEVERITY,SV1,SV2,SV3
N LOOPDT,LOOPEND ; WCJ;IB*2.0*650
K ^TMP("IBCECSA",$J),^TMP("IBCECSB",$J),^TMP("IBCECSD",$J)
W !!,"Compiling CSA status messages ... "
S IBMCCF=^TMP("IBRTYP",$J,0) ; "M"CCF, "N"on-MCCF or "B"oth - IB*2.0*623
S IBSEV=$G(IBSEV,"R")
S VALMCNT=0,IB364=""
S SEVERITY=""
; 'R'ejects only
I IBSEV="R" D
.F S SEVERITY=$O(^IBM(361,"ACSA",SEVERITY)) Q:SEVERITY="" I SEVERITY="R"!(IBSEV="B") D
.. S IBREV="" F S IBREV=$O(^IBM(361,"ACSA",SEVERITY,IBREV)) Q:IBREV="" I IBREV<2 D
... S IBDA=0 F S IBDA=$O(^IBM(361,"ACSA",SEVERITY,IBREV,IBDA)) Q:'IBDA D TAG
; 'B'oth Rejects and Informational Messages - go by dates
I IBSEV="B" D
. S LOOPDT=$$FMADD^XLFDT(INFOSTDT,,,,-1)
. S LOOPEND=$$FMADD^XLFDT(INFOENDT,1,,,-1)
. F S LOOPDT=$O(^IBM(361,"ARD",LOOPDT)) Q:'+LOOPDT!(LOOPDT>LOOPEND) D
.. S IBDA="" F S IBDA=$O(^IBM(361,"ARD",LOOPDT,IBDA)) Q:IBDA="" D
... S IBREV=$P($G(^IBM(361,IBDA,0)),U,9)
... Q:IBREV'<2
... S SEVERITY=$P($G(^IBM(361,IBDA,0)),U,3)
... D TAG
;
I '$D(^TMP("IBCECSB",$J)) D NMAT Q
D SCRN
Q
;
NMAT ;No CSA list
S VALMCNT=2,IBCNT=2
S ^TMP("IBCECSA",$J,1,0)=" "
S ^TMP("IBCECSA",$J,2,0)="No Messages Matching Selection Criteria Found"
Q
;
SRTV(SORT,IBDA) ; sort value calculation given the sort code letter
I SORT="" Q IBDA
Q $$SV^IBCECSA(SORT)
;
SCRN ;
NEW IBSRT1,IBSRT2,IBSRT3,IBX,IBCNT,IBIFN,IBDA,IB,INFX,DAT,X
W !,"Building the CSA list display ... "
S IBCNT=0,IBSRT1=""
F S IBSRT1=$O(^TMP("IBCECSB",$J,IBSRT1)) Q:IBSRT1="" D
. D SRTBRK(1,$G(IBSORT1),IBSRT1)
. S IBSRT2=""
. F S IBSRT2=$O(^TMP("IBCECSB",$J,IBSRT1,IBSRT2)) Q:IBSRT2="" D
.. D SRTBRK(2,$G(IBSORT2),IBSRT2)
.. S IBSRT3=""
.. F S IBSRT3=$O(^TMP("IBCECSB",$J,IBSRT1,IBSRT2,IBSRT3)) Q:IBSRT3="" D
... D SRTBRK(3,$G(IBSORT3),IBSRT3)
... S IBDA=0
... F S IBDA=$O(^TMP("IBCECSB",$J,IBSRT1,IBSRT2,IBSRT3,IBDA)) Q:'IBDA D
.... S IB=$G(^TMP("IBCECSB",$J,IBSRT1,IBSRT2,IBSRT3,IBDA))
.... S IBSTSMSG=$G(^TMP("IBCECSB",$J,IBSRT1,IBSRT2,IBSRT3,IBDA,"MSG"))
.... S IBIFN=+IB
.... S IB364=$P(IB,U,13)
.... S DAT=IBIFN_U_IBDA_U_IBSRT1_U_IBSRT2_U_IB364_U_IBSRT3
.... ;
.... S IBCNT=IBCNT+1
.... S X=$$SETFLD^VALM1($J(IBCNT,3),"","NUMBER")
.... D SETL1(IB,.X)
.... D SET(X,IBCNT,DAT)
.... ;
.... S X=$$SETSTR^VALM1(IBSTSMSG,"",6,75)
.... D SET(X,IBCNT,DAT)
.... Q
... Q
.. Q
. Q
Q
;
SRTBRK(LVL,SORT,IBSRT) ; sort break for display of certain sort data
; LVL - sort level
; SORT - sort letter code
; IBSRT - subscript data
;
NEW IBS,DSPDATA
I '$F(".A.D.N.","."_$G(SORT)_".") G SRTBRKX
S IBS=$$SD^IBCECSA(SORT)
S DSPDATA=IBSRT
I SORT="A" S DSPDATA=$P(DSPDATA,"~",1) ; biller name
I SORT="N" S DSPDATA=-DSPDATA ; number of days pending
D SET($J("",LVL-1)_IBS_": "_DSPDATA,IBCNT,"")
SRTBRKX ;
Q
;
SET(X,CNT,DAT) ;set up list manager screen array
S VALMCNT=VALMCNT+1
I 'CNT S CNT=1
S ^TMP("IBCECSA",$J,VALMCNT,0)=X
S ^TMP("IBCECSA",$J,"IDX",VALMCNT,CNT)=""
I DAT'="" S ^TMP("IBCECSA",$J,CNT)=VALMCNT_U_DAT
Q
;
SETL1(IB,X) ;
S X=$$SETFLD^VALM1($P($G(^DGCR(399,+IB,0)),U,1)_$P(IB,U,12),X,"BILL")
S X=$$SETFLD^VALM1($P(IB,U,2),X,"PNAME")
S X=$$SETFLD^VALM1($P(IB,U,3),X,"PANAME")
S X=$$SETFLD^VALM1($P(IB,U,4),X,"SSN")
S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(IB,U,5),"2Z"),X,"SERVICE")
S X=$$SETFLD^VALM1($J("$"_$FN($P(IB,U,6),"",2),10),X,"CURBAL")
Q
;
TXT(IBDA,LEN) ; Return a string of status message text
; IBDA - ien to file 361
; LEN - desired maximum length of combined text string
NEW MSG,LN,STOP,TX,HLN,REFN,DELIM
S MSG="",LN=0,LEN=$G(LEN,75),STOP=0
F S LN=$O(^IBM(361,+$G(IBDA),1,LN)) Q:'LN D Q:STOP
. S TX=$G(^IBM(361,IBDA,1,LN,0))
. S TX=$$TRIM^XLFSTR(TX)
. ; Don't include parts added by ^IBCE277
. Q:TX="Informational Message:"
. Q:TX="Warning Message:"
. Q:TX="Error Message:"
. I $E(TX,1,27)="Clearinghouse Trace Number:" S STOP=1 Q
. I $E(TX,1,18)="Payer Status Date:" S STOP=1 Q
. I $E(TX,1,19)="Payer Claim Number:" S STOP=1 Q
. I $E(TX,1,12)="Split Claim:" S STOP=1 Q
. I $E(TX,1,11)="Claim Type:" S STOP=1 Q
. I $E(TX,1,8)="Patient:" S STOP=1 Q
. I $E(TX,1,14)="Service Dates:" S STOP=1 Q
. I $E(TX,1,11)="Payer Name:" S STOP=1 Q
. I $E(TX,1,7)="Source:" S STOP=1 Q
. I TX["HL=" S HLN=+$P(TX,"HL=",2),DELIM="HL="_HLN,TX=$P(TX,DELIM,1)_"HL= "_$P(TX,DELIM,2,9)
. I TX["ENVOY REF: " S REFN=$E($P(TX,"ENVOY REF: ",2),1,14),DELIM="ENVOY REF: "_REFN,TX=$P(TX,DELIM,1)_"ENVOY REF: "_$P(TX,DELIM,2,9)
. I ($L(MSG)+$L(TX))>500 S STOP=1 Q
. S MSG=MSG_$S(MSG="":"",1:" ")_TX
. I $L(MSG)>LEN S STOP=1
. Q
Q $E(MSG,1,LEN)
;
;
TAG S IB=$G(^IBM(361,IBDA,0)),IBIFN=+IB
S IBPEN=$$FMDIFF^XLFDT(DT,$P(IB,U,2),1)
;quit if not pending for at least the minimum # of days requested
Q:IBDAYS>IBPEN
S IB399=$G(^DGCR(399,IBIFN,0))
;
; no cancelled claims allowed on the CSA screen
; if we find one, then update the appropriate EDI files
I $P(IB399,U,13)=7 D UPDEDI^IBCEM(+$P(IB,U,11),"C") Q
;
; automatically review this message if the claim was last printed on
; or after the MCS - 'Resubmit by Print' date
I $P(IB,U,16),($P($G(^DGCR(399,IBIFN,"S")),U,14)\1)'<$P(IB,U,16) D UPDEDI^IBCEM(+$P(IB,U,11),"P") Q
;
;/vd - IB*2.0*623 (US141) - Beginning of Code added to support the new sort prompt for MCCF, NON-MCCF or BOTH
S IBRTYP=$P(IB399,U,7),IBNON=0 ;Rate type for claim and variable for identifying the sort criteria.
I $D(^IBE(350.9,1,28,"B",IBRTYP)) S IBNON=1 ; The claim's Rate Type is a Non-MCCF Rate Type.
I IBMCCF="M",+IBNON Q ; User selected only MCCF Rate Types.
I IBMCCF="N",'IBNON Q ; User selected only Non-MCCF Rate Types.
;/vd - IB*2.0*623 (US141) - End
;
S IBDIV=+$P(IB399,U,22)
S IBUER=+$P($G(^DGCR(399,IBIFN,"S")),U,11)
;
; If Request MRA bill, pull the MRA Requestor user instead
I 'IBUER,$P(IB399,U,13)=2 S IBUER=+$P($G(^DGCR(399,IBIFN,"S")),U,8)
I $D(^TMP("IBBIL",$J)),'$D(^TMP("IBBIL",$J,IBUER)) Q ; User not selected
I $D(^TMP("IBDIV",$J)),'$D(^TMP("IBDIV",$J,IBDIV)) Q ; Div not selected
;
S IBPAY=$P($G(^DIC(36,+$P($G(^DGCR(399,IBIFN,"MP")),U),0)),U)
I IBPAY="" S IBPAY=$P($G(^DIC(36,+$$CURR^IBCEF2(IBIFN),0)),U)
I IBPAY="" S IBPAY="UNKNOWN PAYER"
S IBPAT=$G(^DPT(+$P(IB399,U,2),0))
S IBSSN=$E($P(IBPAT,U,9),6,9) I IBSSN="" S IBSSN="~unk"
S IBPAT=$P(IBPAT,U,1) I IBPAT="" S IBPAT="~UNKNOWN PATIENT NAME"
S IBSER=$P($G(^DGCR(399,IBIFN,"U")),U)
S IBLOC=$P(IB399,U,4)
S IBLOC=$S(IBLOC=1:"HOSPITAL",IBLOC=2:"SKILLED NURSING",1:"CLINIC")
I IBDIV S IBDIV=$P($G(^DG(40.8,IBDIV,0)),U)
I IBDIV=""!(IBDIV=0) S IBDIV="UNSPECIFIED"
S IBMSG=$S($P(IB,U,8):"PAYER",1:"NON-PAYER")
S IBUER=$S(IBUER:$P($G(^VA(200,IBUER,0)),U),1:"UNKNOWN")_"~"_IBUER
S IB364=$P(IB,U,11)
S IBOAM=$G(^DGCR(399,IBIFN,"U1"))
S IBOAM=$P(IBOAM,U,1)-$P(IBOAM,U,2) ; current balance (total charges - offset)
;
S IBSTSMSG=$$TXT(IBDA) ; status message text
S IBERR=$E(IBSTSMSG,1,60)
I IBERR="" S IBERR="-"
;
S IB=$$BN1^PRCAFN(IBIFN) ; external bill#
S A=IBIFN_U_IBPAY_U_IBPAT_U_IBSSN_U_IBSER_U_IBOAM_U_IBLOC_U_IBDIV_U_IBUER_U_IBMSG_U_IBPEN_U_$S(IBREV:"*",1:"")_U_IB364_U_IB
;
S SV1=$$SRTV($G(IBSORT1),IBDA)
S SV2=$$SRTV($G(IBSORT2),IBDA)
S SV3=$$SRTV($G(IBSORT3),IBDA)
S ^TMP("IBCECSB",$J,SV1,SV2,SV3,IBDA)=A
S ^TMP("IBCECSB",$J,SV1,SV2,SV3,IBDA,"MSG")=IBSTSMSG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECSA1 8014 printed Dec 13, 2024@02:09:45 Page 2
IBCECSA1 ;ALB/CXW - IB STATUS AWAITING RESOLUTION SCREEN ;28-JUL-99
+1 ;;2.0;INTEGRATED BILLING;**137,283,288,320,368,623,650**;21-MAR-94;Build 21
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ; DBIA for $$BN1^PRCAFN()
+4 ;
BLD ; Build list entrypoint
+1 ;N IBDA,IBREV,IBIFN,IBPAY,IBSSN,IBSER,IB399,IBLOC,IBDIV,IBUER,IBMSG,IBERR,IBPEN,SEVERITY,A,IBOAM,IBPAT,IBSTSMSG,SV1,SV2,SV3
+2 ;/vd-IB*2.0*623 (US141) - Reordered variables
NEW A,IB399,IBDA,IBDIV,IBERR,IBIFN,IBLOC,IBMCCF,IBMSG,IBNON,IBOAM,IBPAT,IBPAY,IBPEN
+3 NEW IBREV,IBRTYP,IBSER,IBSSN,IBSTSMSG,IBUER,SEVERITY,SV1,SV2,SV3
+4 ; WCJ;IB*2.0*650
NEW LOOPDT,LOOPEND
+5 KILL ^TMP("IBCECSA",$JOB),^TMP("IBCECSB",$JOB),^TMP("IBCECSD",$JOB)
+6 WRITE !!,"Compiling CSA status messages ... "
+7 ; "M"CCF, "N"on-MCCF or "B"oth - IB*2.0*623
SET IBMCCF=^TMP("IBRTYP",$JOB,0)
+8 SET IBSEV=$GET(IBSEV,"R")
+9 SET VALMCNT=0
SET IB364=""
+10 SET SEVERITY=""
+11 ; 'R'ejects only
+12 IF IBSEV="R"
Begin DoDot:1
+13 FOR
SET SEVERITY=$ORDER(^IBM(361,"ACSA",SEVERITY))
if SEVERITY=""
QUIT
IF SEVERITY="R"!(IBSEV="B")
Begin DoDot:2
+14 SET IBREV=""
FOR
SET IBREV=$ORDER(^IBM(361,"ACSA",SEVERITY,IBREV))
if IBREV=""
QUIT
IF IBREV<2
Begin DoDot:3
+15 SET IBDA=0
FOR
SET IBDA=$ORDER(^IBM(361,"ACSA",SEVERITY,IBREV,IBDA))
if 'IBDA
QUIT
DO TAG
End DoDot:3
End DoDot:2
End DoDot:1
+16 ; 'B'oth Rejects and Informational Messages - go by dates
+17 IF IBSEV="B"
Begin DoDot:1
+18 SET LOOPDT=$$FMADD^XLFDT(INFOSTDT,,,,-1)
+19 SET LOOPEND=$$FMADD^XLFDT(INFOENDT,1,,,-1)
+20 FOR
SET LOOPDT=$ORDER(^IBM(361,"ARD",LOOPDT))
if '+LOOPDT!(LOOPDT>LOOPEND)
QUIT
Begin DoDot:2
+21 SET IBDA=""
FOR
SET IBDA=$ORDER(^IBM(361,"ARD",LOOPDT,IBDA))
if IBDA=""
QUIT
Begin DoDot:3
+22 SET IBREV=$PIECE($GET(^IBM(361,IBDA,0)),U,9)
+23 if IBREV'<2
QUIT
+24 SET SEVERITY=$PIECE($GET(^IBM(361,IBDA,0)),U,3)
+25 DO TAG
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;
+27 IF '$DATA(^TMP("IBCECSB",$JOB))
DO NMAT
QUIT
+28 DO SCRN
+29 QUIT
+30 ;
NMAT ;No CSA list
+1 SET VALMCNT=2
SET IBCNT=2
+2 SET ^TMP("IBCECSA",$JOB,1,0)=" "
+3 SET ^TMP("IBCECSA",$JOB,2,0)="No Messages Matching Selection Criteria Found"
+4 QUIT
+5 ;
SRTV(SORT,IBDA) ; sort value calculation given the sort code letter
+1 IF SORT=""
QUIT IBDA
+2 QUIT $$SV^IBCECSA(SORT)
+3 ;
SCRN ;
+1 NEW IBSRT1,IBSRT2,IBSRT3,IBX,IBCNT,IBIFN,IBDA,IB,INFX,DAT,X
+2 WRITE !,"Building the CSA list display ... "
+3 SET IBCNT=0
SET IBSRT1=""
+4 FOR
SET IBSRT1=$ORDER(^TMP("IBCECSB",$JOB,IBSRT1))
if IBSRT1=""
QUIT
Begin DoDot:1
+5 DO SRTBRK(1,$GET(IBSORT1),IBSRT1)
+6 SET IBSRT2=""
+7 FOR
SET IBSRT2=$ORDER(^TMP("IBCECSB",$JOB,IBSRT1,IBSRT2))
if IBSRT2=""
QUIT
Begin DoDot:2
+8 DO SRTBRK(2,$GET(IBSORT2),IBSRT2)
+9 SET IBSRT3=""
+10 FOR
SET IBSRT3=$ORDER(^TMP("IBCECSB",$JOB,IBSRT1,IBSRT2,IBSRT3))
if IBSRT3=""
QUIT
Begin DoDot:3
+11 DO SRTBRK(3,$GET(IBSORT3),IBSRT3)
+12 SET IBDA=0
+13 FOR
SET IBDA=$ORDER(^TMP("IBCECSB",$JOB,IBSRT1,IBSRT2,IBSRT3,IBDA))
if 'IBDA
QUIT
Begin DoDot:4
+14 SET IB=$GET(^TMP("IBCECSB",$JOB,IBSRT1,IBSRT2,IBSRT3,IBDA))
+15 SET IBSTSMSG=$GET(^TMP("IBCECSB",$JOB,IBSRT1,IBSRT2,IBSRT3,IBDA,"MSG"))
+16 SET IBIFN=+IB
+17 SET IB364=$PIECE(IB,U,13)
+18 SET DAT=IBIFN_U_IBDA_U_IBSRT1_U_IBSRT2_U_IB364_U_IBSRT3
+19 ;
+20 SET IBCNT=IBCNT+1
+21 SET X=$$SETFLD^VALM1($JUSTIFY(IBCNT,3),"","NUMBER")
+22 DO SETL1(IB,.X)
+23 DO SET(X,IBCNT,DAT)
+24 ;
+25 SET X=$$SETSTR^VALM1(IBSTSMSG,"",6,75)
+26 DO SET(X,IBCNT,DAT)
+27 QUIT
End DoDot:4
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 QUIT
+32 ;
SRTBRK(LVL,SORT,IBSRT) ; sort break for display of certain sort data
+1 ; LVL - sort level
+2 ; SORT - sort letter code
+3 ; IBSRT - subscript data
+4 ;
+5 NEW IBS,DSPDATA
+6 IF '$FIND(".A.D.N.","."_$GET(SORT)_".")
GOTO SRTBRKX
+7 SET IBS=$$SD^IBCECSA(SORT)
+8 SET DSPDATA=IBSRT
+9 ; biller name
IF SORT="A"
SET DSPDATA=$PIECE(DSPDATA,"~",1)
+10 ; number of days pending
IF SORT="N"
SET DSPDATA=-DSPDATA
+11 DO SET($JUSTIFY("",LVL-1)_IBS_": "_DSPDATA,IBCNT,"")
SRTBRKX ;
+1 QUIT
+2 ;
SET(X,CNT,DAT) ;set up list manager screen array
+1 SET VALMCNT=VALMCNT+1
+2 IF 'CNT
SET CNT=1
+3 SET ^TMP("IBCECSA",$JOB,VALMCNT,0)=X
+4 SET ^TMP("IBCECSA",$JOB,"IDX",VALMCNT,CNT)=""
+5 IF DAT'=""
SET ^TMP("IBCECSA",$JOB,CNT)=VALMCNT_U_DAT
+6 QUIT
+7 ;
SETL1(IB,X) ;
+1 SET X=$$SETFLD^VALM1($PIECE($GET(^DGCR(399,+IB,0)),U,1)_$PIECE(IB,U,12),X,"BILL")
+2 SET X=$$SETFLD^VALM1($PIECE(IB,U,2),X,"PNAME")
+3 SET X=$$SETFLD^VALM1($PIECE(IB,U,3),X,"PANAME")
+4 SET X=$$SETFLD^VALM1($PIECE(IB,U,4),X,"SSN")
+5 SET X=$$SETFLD^VALM1($$FMTE^XLFDT($PIECE(IB,U,5),"2Z"),X,"SERVICE")
+6 SET X=$$SETFLD^VALM1($JUSTIFY("$"_$FNUMBER($PIECE(IB,U,6),"",2),10),X,"CURBAL")
+7 QUIT
+8 ;
TXT(IBDA,LEN) ; Return a string of status message text
+1 ; IBDA - ien to file 361
+2 ; LEN - desired maximum length of combined text string
+3 NEW MSG,LN,STOP,TX,HLN,REFN,DELIM
+4 SET MSG=""
SET LN=0
SET LEN=$GET(LEN,75)
SET STOP=0
+5 FOR
SET LN=$ORDER(^IBM(361,+$GET(IBDA),1,LN))
if 'LN
QUIT
Begin DoDot:1
+6 SET TX=$GET(^IBM(361,IBDA,1,LN,0))
+7 SET TX=$$TRIM^XLFSTR(TX)
+8 ; Don't include parts added by ^IBCE277
+9 if TX="Informational Message
QUIT
+10 if TX="Warning Message
QUIT
+11 if TX="Error Message
QUIT
+12 IF $EXTRACT(TX,1,27)="Clearinghouse Trace Number:"
SET STOP=1
QUIT
+13 IF $EXTRACT(TX,1,18)="Payer Status Date:"
SET STOP=1
QUIT
+14 IF $EXTRACT(TX,1,19)="Payer Claim Number:"
SET STOP=1
QUIT
+15 IF $EXTRACT(TX,1,12)="Split Claim:"
SET STOP=1
QUIT
+16 IF $EXTRACT(TX,1,11)="Claim Type:"
SET STOP=1
QUIT
+17 IF $EXTRACT(TX,1,8)="Patient:"
SET STOP=1
QUIT
+18 IF $EXTRACT(TX,1,14)="Service Dates:"
SET STOP=1
QUIT
+19 IF $EXTRACT(TX,1,11)="Payer Name:"
SET STOP=1
QUIT
+20 IF $EXTRACT(TX,1,7)="Source:"
SET STOP=1
QUIT
+21 IF TX["HL="
SET HLN=+$PIECE(TX,"HL=",2)
SET DELIM="HL="_HLN
SET TX=$PIECE(TX,DELIM,1)_"HL= "_$PIECE(TX,DELIM,2,9)
+22 IF TX["ENVOY REF: "
SET REFN=$EXTRACT($PIECE(TX,"ENVOY REF: ",2),1,14)
SET DELIM="ENVOY REF: "_REFN
SET TX=$PIECE(TX,DELIM,1)_"ENVOY REF: "_$PIECE(TX,DELIM,2,9)
+23 IF ($LENGTH(MSG)+$LENGTH(TX))>500
SET STOP=1
QUIT
+24 SET MSG=MSG_$SELECT(MSG="":"",1:" ")_TX
+25 IF $LENGTH(MSG)>LEN
SET STOP=1
+26 QUIT
End DoDot:1
if STOP
QUIT
+27 QUIT $EXTRACT(MSG,1,LEN)
+28 ;
+29 ;
TAG SET IB=$GET(^IBM(361,IBDA,0))
SET IBIFN=+IB
+1 SET IBPEN=$$FMDIFF^XLFDT(DT,$PIECE(IB,U,2),1)
+2 ;quit if not pending for at least the minimum # of days requested
+3 if IBDAYS>IBPEN
QUIT
+4 SET IB399=$GET(^DGCR(399,IBIFN,0))
+5 ;
+6 ; no cancelled claims allowed on the CSA screen
+7 ; if we find one, then update the appropriate EDI files
+8 IF $PIECE(IB399,U,13)=7
DO UPDEDI^IBCEM(+$PIECE(IB,U,11),"C")
QUIT
+9 ;
+10 ; automatically review this message if the claim was last printed on
+11 ; or after the MCS - 'Resubmit by Print' date
+12 IF $PIECE(IB,U,16)
IF ($PIECE($GET(^DGCR(399,IBIFN,"S")),U,14)\1)'<$PIECE(IB,U,16)
DO UPDEDI^IBCEM(+$PIECE(IB,U,11),"P")
QUIT
+13 ;
+14 ;/vd - IB*2.0*623 (US141) - Beginning of Code added to support the new sort prompt for MCCF, NON-MCCF or BOTH
+15 ;Rate type for claim and variable for identifying the sort criteria.
SET IBRTYP=$PIECE(IB399,U,7)
SET IBNON=0
+16 ; The claim's Rate Type is a Non-MCCF Rate Type.
IF $DATA(^IBE(350.9,1,28,"B",IBRTYP))
SET IBNON=1
+17 ; User selected only MCCF Rate Types.
IF IBMCCF="M"
IF +IBNON
QUIT
+18 ; User selected only Non-MCCF Rate Types.
IF IBMCCF="N"
IF 'IBNON
QUIT
+19 ;/vd - IB*2.0*623 (US141) - End
+20 ;
+21 SET IBDIV=+$PIECE(IB399,U,22)
+22 SET IBUER=+$PIECE($GET(^DGCR(399,IBIFN,"S")),U,11)
+23 ;
+24 ; If Request MRA bill, pull the MRA Requestor user instead
+25 IF 'IBUER
IF $PIECE(IB399,U,13)=2
SET IBUER=+$PIECE($GET(^DGCR(399,IBIFN,"S")),U,8)
+26 ; User not selected
IF $DATA(^TMP("IBBIL",$JOB))
IF '$DATA(^TMP("IBBIL",$JOB,IBUER))
QUIT
+27 ; Div not selected
IF $DATA(^TMP("IBDIV",$JOB))
IF '$DATA(^TMP("IBDIV",$JOB,IBDIV))
QUIT
+28 ;
+29 SET IBPAY=$PIECE($GET(^DIC(36,+$PIECE($GET(^DGCR(399,IBIFN,"MP")),U),0)),U)
+30 IF IBPAY=""
SET IBPAY=$PIECE($GET(^DIC(36,+$$CURR^IBCEF2(IBIFN),0)),U)
+31 IF IBPAY=""
SET IBPAY="UNKNOWN PAYER"
+32 SET IBPAT=$GET(^DPT(+$PIECE(IB399,U,2),0))
+33 SET IBSSN=$EXTRACT($PIECE(IBPAT,U,9),6,9)
IF IBSSN=""
SET IBSSN="~unk"
+34 SET IBPAT=$PIECE(IBPAT,U,1)
IF IBPAT=""
SET IBPAT="~UNKNOWN PATIENT NAME"
+35 SET IBSER=$PIECE($GET(^DGCR(399,IBIFN,"U")),U)
+36 SET IBLOC=$PIECE(IB399,U,4)
+37 SET IBLOC=$SELECT(IBLOC=1:"HOSPITAL",IBLOC=2:"SKILLED NURSING",1:"CLINIC")
+38 IF IBDIV
SET IBDIV=$PIECE($GET(^DG(40.8,IBDIV,0)),U)
+39 IF IBDIV=""!(IBDIV=0)
SET IBDIV="UNSPECIFIED"
+40 SET IBMSG=$SELECT($PIECE(IB,U,8):"PAYER",1:"NON-PAYER")
+41 SET IBUER=$SELECT(IBUER:$PIECE($GET(^VA(200,IBUER,0)),U),1:"UNKNOWN")_"~"_IBUER
+42 SET IB364=$PIECE(IB,U,11)
+43 SET IBOAM=$GET(^DGCR(399,IBIFN,"U1"))
+44 ; current balance (total charges - offset)
SET IBOAM=$PIECE(IBOAM,U,1)-$PIECE(IBOAM,U,2)
+45 ;
+46 ; status message text
SET IBSTSMSG=$$TXT(IBDA)
+47 SET IBERR=$EXTRACT(IBSTSMSG,1,60)
+48 IF IBERR=""
SET IBERR="-"
+49 ;
+50 ; external bill#
SET IB=$$BN1^PRCAFN(IBIFN)
+51 SET A=IBIFN_U_IBPAY_U_IBPAT_U_IBSSN_U_IBSER_U_IBOAM_U_IBLOC_U_IBDIV_U_IBUER_U_IBMSG_U_IBPEN_U_$SELECT(IBREV:"*",1:"")_U_IB364_U_IB
+52 ;
+53 SET SV1=$$SRTV($GET(IBSORT1),IBDA)
+54 SET SV2=$$SRTV($GET(IBSORT2),IBDA)
+55 SET SV3=$$SRTV($GET(IBSORT3),IBDA)
+56 SET ^TMP("IBCECSB",$JOB,SV1,SV2,SV3,IBDA)=A
+57 SET ^TMP("IBCECSB",$JOB,SV1,SV2,SV3,IBDA,"MSG")=IBSTSMSG
+58 QUIT
