IBJTTC ;ALB/ARH/PJH - TPI AR COMMENT HISTORY ; 3/18/11 2:15pm
;;2.0;INTEGRATED BILLING;**39,377,431,432,447,547**;21-MAR-94;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;
; AR Profile of Comments: This screen prints the following Comments:
; Bill Comments (430,98) - entered during auditing
; For each COMMENT Transaction:
; Brief Comment (433,5.02)
; Transaction Comment (433,86)
; Comment (433,41)
;
EN ; -- main entry point for IBJT AR COMMENT HISTORY
D EN^VALM("IBJT AR COMMENT HISTORY")
Q
;
HDR ; -- header code
D HDR^IBJTU1(+IBIFN,+DFN,13)
Q
;
INIT ; -- init variables and list array
K ^TMP("IBJTTC",$J)
I '$G(DFN)!'$G(IBIFN) S VALMQUIT="" G INITQ
D BLD
INITQ Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBJTTC",$J)
D CLEAR^VALM1
Q
;
BLD ;
N CMLN,CMSTR,X,IBCNT,IBZ,IB0,IBI,IBX,IBD,IBDATE,IBDUZ,IBRCT5,IBLN,IBSTR,IBK,IBJ,DIWL,DIWR,DIWF,COM
; HIPAA 5010
N IB3611,FOUND
;
S VALMCNT=0,IBLN=0
;
; Bill Comments (430,98)
K COM,^UTILITY($J,"W") D BCOM^RCJIBFN2(IBIFN) I $D(COM)>10 D
. S IBSTR="",IBD="AR BILL COMMENTS:" S IBSTR=$$SETLN(IBD,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
. S IBSTR="",IBSTR=$$SETLN("--------------------------",IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
. ;
. S IBJ="" F S IBJ=$O(COM(IBJ)) Q:'IBJ S X=$G(COM(IBJ)) I X'="" S DIWL=1,DIWR=54,DIWF="" D ^DIWP
. ;
. I $D(^UTILITY($J,"W")) S (IBK,IBCNT)=0 F S IBK=$O(^UTILITY($J,"W",1,IBK)) Q:'IBK D
.. S IBD=$G(^UTILITY($J,"W",1,IBK,0)) S IBSTR=$$SETLN(IBD,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
. K ^UTILITY($J,"W")
; AR profile of comment transactions (433: 5.02, 41, 86)
K ^TMP("RCJIB",$J),^UTILITY($J,"W") D TRN^RCJIBFN2(IBIFN)
;
;HIPAA 5010 - check if contact data has been added as a comment
I '$$CONTACT D
.;Check for payer contact data in all entries associated with the bill # (IBIFN)
.S (FOUND,IB3611)=0 F S IB3611=$O(^IBM(361.1,"B",IBIFN,IB3611)) Q:'IB3611 Q:FOUND S FOUND=$$EN^RCDPAYER(IB3611)
.Q:'FOUND ; payer contact data does not exist in any of the EOB entries related to claim
.;Add canned text as a brief comment in file #433 which will serve as a notice that contact data came from 835 ERA
.D ADD^RCDPAYER(IBIFN) ;IA 5549
.;Rebuild AR profile of comment transactions
.K ^TMP("RCJIB",$J),^UTILITY($J,"W") D TRN^RCJIBFN2(IBIFN)
;
I $D(^TMP("RCJIB",$J)) S IBI="" F S IBI=$O(^TMP("RCJIB",$J,IBI)) Q:'IBI D
. S IBX=$G(^TMP("RCJIB",$J,IBI)) I $$STNO^RCJIBFN2(+$P(IBX,U,3))'["COMMENT" Q
. S IBRCT5=$$N5^RCJIBFN1(IBI)
. S IBSTR="",IBLN=$$SET(IBSTR,IBLN)
. S IBD=$P(IBX,U,1) S IBSTR=$$SETLN(IBD,IBSTR,2,8)
. S IBD=$$DATE(+$P(IBX,U,2)) S IBSTR=$$SETLN(IBD,IBSTR,14,8)
. S IBD=$P(IBRCT5,U,1) S IBSTR=$$SETLN(IBD,IBSTR,25,30)
. S IBD="FOLLOW-UP DT: "_$$DATE(+$P(IBRCT5,U,2)) S IBSTR=$$SETLN(IBD,IBSTR,57,22)
. S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
.;HIPAA 5010 - check if this comment is contact data
.I $P(IBRCT5,U)["ERA Payer Contact Information" D
..N CONTACT,PHONE,FAX,EMAIL,WEB,NAME,EXT,PAYER,HAVPAYER
..;Display contact data IA 5549
..; primary, secondary, and tertiary contact data need to be displayed. Display of contact data
..; should only occur for each unique payer at BILL (B) x-ref of IBM(361.1,"B",IBIFN).
..; evaluation starts with the most recent entry.
..; Contact data belonging to more than one payer can be distinguished by payer name
..S (HAVPAYER,IB3611)=""
..F S IB3611=$O(^IBM(361.1,"B",IBIFN,IB3611),-1) Q:'IB3611 S CONTACT=$$EN^RCDPAYER(IB3611) D
...Q:'CONTACT
...S PAYER=$P($G(^IBM(361.1,IB3611,0)),U,2),PAYER=$$EXTERNAL^DILFD(361.1,.02,,PAYER) ;IA 4051
...Q:PAYER=HAVPAYER ; payer contact data has already been displayed
...S HAVPAYER=PAYER
...S FAX=$P(CONTACT,U,5),EMAIL=$P(CONTACT,U,6),WEB=$P(CONTACT,U,3)
...S PHONE=$P(CONTACT,U,4),EXT=$P(CONTACT,U,7),NAME=$P(CONTACT,U,2)
...S IBD="Payer Name: "_PAYER
...S IBSTR=$$SETLN(IBD,IBSTR,25,78)
...S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
...I NAME]"" D
....S IBD="Contact Name: "_NAME
....S IBSTR=$$SETLN(IBD,IBSTR,25,78)
....S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
...I PHONE]"" D
....S IBD="Phone Number: "_PHONE S:EXT]"" IBD=IBD_" Ext: "_EXT
....S IBSTR=$$SETLN(IBD,IBSTR,25,78)
....S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
...I FAX]"" D
....S IBD="Facsimile Number: "_FAX
....S IBSTR=$$SETLN(IBD,IBSTR,25,78)
....S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
...I EMAIL]"" D
....S IBD="Email Address: "_EMAIL
....S IBSTR=$$SETLN(IBD,IBSTR,25,78)
....S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
...I WEB]"" D
....S IBD="Website Address:"_$E(WEB,1,40)
....S IBSTR=$$SETLN(IBD,IBSTR,25,78)
....S IBLN=$$SET(IBSTR,IBLN),IBSTR="" Q:$L(WEB)<41
....S IBSTR=$$SETLN($E(WEB,41,96),IBSTR,25,78)
....S IBLN=$$SET(IBSTR,IBLN),IBSTR="" Q:$L(WEB)<97
....S IBSTR=$$SETLN($E(WEB,97,115),IBSTR,25,78)
....S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
...S IBLN=$$SET(IBSTR,IBLN)
. ;
. ; -- transaction comments (86)
. S X=$P($G(^TMP("RCJIB",$J,IBI)),U,6) I X'="" S DIWL=1,DIWR=54,DIWF="" D ^DIWP
. ;
. ; -- comments (86 & 41)
. K COM D N7^RCJIBFN1(IBI) I $D(COM)>2 D
.. S IBJ="" F S IBJ=$O(COM(IBJ)) Q:'IBJ S X=$G(COM(IBJ)) I X'="" S DIWL=1,DIWR=54,DIWF="" D ^DIWP
. ;
. I $D(^UTILITY($J,"W")) S (IBK,IBCNT)=0 F S IBK=$O(^UTILITY($J,"W",1,IBK)) Q:'IBK D
.. S IBD=$G(^UTILITY($J,"W",1,IBK,0)) S IBSTR=$$SETLN(IBD,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
. K ^UTILITY($J,"W")
K ^TMP("RCJIB",$J),^UTILITY($J,"W")
; MRA comments
; check if we have any comments to display
I $D(^DGCR(399,IBIFN,"TXC","B")) D
.S IBLN=$$SET("",IBLN)
.S IBSTR="",IBSTR=$$SETLN("MRA REQUEST CLAIM COMMENTS",IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
.S IBSTR="",IBSTR=$$SETLN("--------------------------",IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
.; loop through all available comments
.S IBDATE="" F S IBDATE=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE),-1) Q:IBDATE="" D
..S IBZ=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE,"")),IB0=^DGCR(399,IBIFN,"TXC",IBZ,0),IBDUZ=$P(IB0,U,2)
..;S IBLN=$$SET("",IBLN)
..S IBSTR=""
..S IBSTR=$$SETLN($$FMTE^XLFDT(IBDATE,"2Z"),IBSTR,14,8)
..S IBSTR=$$SETLN($J("Entered by "_$$GET1^DIQ(200,IBDUZ,.01),54),IBSTR,25,54)
..S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
..; loop through comment lines
..S CMLN=0 F S CMLN=$O(^DGCR(399,IBIFN,"TXC",IBZ,1,CMLN)) Q:CMLN="" D
...S X=^DGCR(399,IBIFN,"TXC",IBZ,1,CMLN,0) I X'="" S DIWL=1,DIWR=54,DIWF="" D ^DIWP
...Q
..I $D(^UTILITY($J,"W")) S IBK=0 F S IBK=$O(^UTILITY($J,"W",1,IBK)) Q:'IBK D
...S CMSTR=$G(^UTILITY($J,"W",1,IBK,0)) S IBSTR=$$SETLN(CMSTR,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
...Q
..K ^UTILITY($J,"W")
..Q
.;D CLEAN^DILF
.Q
; display RFAI Claim Comments right after MRA REQUEST CLAIM COMMENTS *IB*2.0*547
D RFAIC
D EOBC ; IB*2.0*432
D MDACMTS ; IB*2.0*447 BI
D CLEAN^DILF
;
I IBLN=0 S IBLN=$$SET("",IBLN),IBLN=$$SET("No Comment Transactions Exist For This Account.",IBLN)
S VALMCNT=IBLN
Q
;
EOBC ; check for new EOB comments IB*2.0*432
I $D(^DGCR(399,IBIFN,"TXC2","B")) D
.S IBLN=$$SET("",IBLN)
.S IBSTR="",IBSTR=$$SETLN("COB MANAGMENT CLAIM COMMENTS",IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
.S IBSTR="",IBSTR=$$SETLN("----------------------------",IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
.; loop through all available comments
.S IBDATE="" F S IBDATE=$O(^DGCR(399,IBIFN,"TXC2","B",IBDATE),-1) Q:IBDATE="" D
..S IBZ=$O(^DGCR(399,IBIFN,"TXC2","B",IBDATE,"")),IB0=^DGCR(399,IBIFN,"TXC2",IBZ,0),IBDUZ=$P(IB0,U,2)
..;S IBLN=$$SET("",IBLN)
..S IBSTR=""
..S IBSTR=$$SETLN($$FMTE^XLFDT(IBDATE,"2Z"),IBSTR,14,8)
..S IBSTR=$$SETLN($J("Entered by "_$$GET1^DIQ(200,IBDUZ,.01),54),IBSTR,25,54)
..S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
..; loop through comment lines
..S CMLN=0 F S CMLN=$O(^DGCR(399,IBIFN,"TXC2",IBZ,1,CMLN)) Q:CMLN="" D
...S X=^DGCR(399,IBIFN,"TXC2",IBZ,1,CMLN,0) I X'="" S DIWL=1,DIWR=54,DIWF="" D ^DIWP
...Q
..I $D(^UTILITY($J,"W")) S IBK=0 F S IBK=$O(^UTILITY($J,"W",1,IBK)) Q:'IBK D
...S CMSTR=$G(^UTILITY($J,"W",1,IBK,0)) S IBSTR=$$SETLN(CMSTR,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
...Q
..K ^UTILITY($J,"W")
..Q
.Q
Q
;
CONTACT() ;HIPAA 5010 check for contact data in comments
N FOUND,IBI
S FOUND=0,IBI=""
F S IBI=$O(^TMP("RCJIB",$J,IBI)) Q:'IBI D Q:FOUND
.S IBX=$G(^TMP("RCJIB",$J,IBI)) Q:$$STNO^RCJIBFN2(+$P(IBX,U,3))'["COMMENT"
.S:$P($$N5^RCJIBFN1(IBI),U)["ERA Payer Contact Information" FOUND=1
Q FOUND
;
DATE(X) ; date in external format
N Y S Y="" I +X S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
Q Y
;
SETLN(STR,IBX,COL,WD) ;
S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
Q IBX
;
SET(STR,LN) ; set up TMP array with screen data
S LN=LN+1 D SET^VALM10(LN,STR)
SETQ Q LN
;
MDACMTS ; Check for MDA comments, Load for List Manager Screen IB*2.0*447 BI
; INTEGRATION CONTROL REGISTRATION is contained in DBIA #5696.
D MCOM^PRCAMDA2(IBIFN,.IBLN)
Q
;
RFAIC ; check for new RFAI comments IB*2.0*547 (modeled after EOBC)
; uses ^IBA(368,"D",$E(X,1,30),DA) PATIENT CONTROL NUMBER [D] cross-reference
;
Q:'$D(^IBA(368,"D",IBIFN))
N IBTNI,IBC,IBCLM,IBDUZ,IBDT,IBK,CMSTR,IBSTR,IBZ
; loop through all available comments
S IBC=0,IBTNI="" F S IBTNI=$O(^IBA(368,"D",IBIFN,IBTNI)) Q:IBTNI="" D
.; not all transactions associated with a claim have comments
.Q:'$D(^IBA(368,IBTNI,201))
.; loop through all available comments
.S IBDT="" F S IBDT=$O(^IBA(368,IBTNI,201,"B",IBDT),-1) Q:IBDT="" D
..S IBZ=$O(^IBA(368,IBTNI,201,"B",IBDT,"")),IBDUZ=$P($G(^IBA(368,IBTNI,201,IBZ,0)),U,2),IBC=IBC+1
..; display header and underline prior to 1st transaction with comment only
..D:IBC=1
...S IBLN=$$SET("",IBLN)
...S IBSTR="",IBSTR=$$SETLN("RFAI CLAIM COMMENTS",IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
...S IBSTR="",IBSTR=$$SETLN("----------------------------",IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
..S IBSTR="",IBSTR=$$SETLN($$FMTE^XLFDT(IBDT,"2Z"),IBSTR,14,8),IBSTR=$$SETLN($J("Entered by "_$$GET1^DIQ(200,IBDUZ,.01),54),IBSTR,25,54)
..S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
..; loop through comment lines
..S IBCLM=0 F S IBCLM=$O(^IBA(368,IBTNI,201,IBZ,1,IBCLM)) Q:IBCLM="" D
...S X=$G(^IBA(368,IBTNI,201,IBZ,1,IBCLM,0)) I X'="" S DIWL=1,DIWR=54,DIWF="" D ^DIWP
..I $D(^UTILITY($J,"W")) S IBK=0 F S IBK=$O(^UTILITY($J,"W",1,IBK)) Q:'IBK D
...S CMSTR=$G(^UTILITY($J,"W",1,IBK,0)) S IBSTR=$$SETLN(CMSTR,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
..K ^UTILITY($J,"W")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTTC 10573 printed Dec 13, 2024@02:24:12 Page 2
IBJTTC ;ALB/ARH/PJH - TPI AR COMMENT HISTORY ; 3/18/11 2:15pm
+1 ;;2.0;INTEGRATED BILLING;**39,377,431,432,447,547**;21-MAR-94;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; AR Profile of Comments: This screen prints the following Comments:
+5 ; Bill Comments (430,98) - entered during auditing
+6 ; For each COMMENT Transaction:
+7 ; Brief Comment (433,5.02)
+8 ; Transaction Comment (433,86)
+9 ; Comment (433,41)
+10 ;
EN ; -- main entry point for IBJT AR COMMENT HISTORY
+1 DO EN^VALM("IBJT AR COMMENT HISTORY")
+2 QUIT
+3 ;
HDR ; -- header code
+1 DO HDR^IBJTU1(+IBIFN,+DFN,13)
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("IBJTTC",$JOB)
+2 IF '$GET(DFN)!'$GET(IBIFN)
SET VALMQUIT=""
GOTO INITQ
+3 DO BLD
INITQ QUIT
+1 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBJTTC",$JOB)
+2 DO CLEAR^VALM1
+3 QUIT
+4 ;
BLD ;
+1 NEW CMLN,CMSTR,X,IBCNT,IBZ,IB0,IBI,IBX,IBD,IBDATE,IBDUZ,IBRCT5,IBLN,IBSTR,IBK,IBJ,DIWL,DIWR,DIWF,COM
+2 ; HIPAA 5010
+3 NEW IB3611,FOUND
+4 ;
+5 SET VALMCNT=0
SET IBLN=0
+6 ;
+7 ; Bill Comments (430,98)
+8 KILL COM,^UTILITY($JOB,"W")
DO BCOM^RCJIBFN2(IBIFN)
IF $DATA(COM)>10
Begin DoDot:1
+9 SET IBSTR=""
SET IBD="AR BILL COMMENTS:"
SET IBSTR=$$SETLN(IBD,IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
+10 SET IBSTR=""
SET IBSTR=$$SETLN("--------------------------",IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
+11 ;
+12 SET IBJ=""
FOR
SET IBJ=$ORDER(COM(IBJ))
if 'IBJ
QUIT
SET X=$GET(COM(IBJ))
IF X'=""
SET DIWL=1
SET DIWR=54
SET DIWF=""
DO ^DIWP
+13 ;
+14 IF $DATA(^UTILITY($JOB,"W"))
SET (IBK,IBCNT)=0
FOR
SET IBK=$ORDER(^UTILITY($JOB,"W",1,IBK))
if 'IBK
QUIT
Begin DoDot:2
+15 SET IBD=$GET(^UTILITY($JOB,"W",1,IBK,0))
SET IBSTR=$$SETLN(IBD,IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
End DoDot:2
+16 KILL ^UTILITY($JOB,"W")
End DoDot:1
+17 ; AR profile of comment transactions (433: 5.02, 41, 86)
+18 KILL ^TMP("RCJIB",$JOB),^UTILITY($JOB,"W")
DO TRN^RCJIBFN2(IBIFN)
+19 ;
+20 ;HIPAA 5010 - check if contact data has been added as a comment
+21 IF '$$CONTACT
Begin DoDot:1
+22 ;Check for payer contact data in all entries associated with the bill # (IBIFN)
+23 SET (FOUND,IB3611)=0
FOR
SET IB3611=$ORDER(^IBM(361.1,"B",IBIFN,IB3611))
if 'IB3611
QUIT
if FOUND
QUIT
SET FOUND=$$EN^RCDPAYER(IB3611)
+24 ; payer contact data does not exist in any of the EOB entries related to claim
if 'FOUND
QUIT
+25 ;Add canned text as a brief comment in file #433 which will serve as a notice that contact data came from 835 ERA
+26 ;IA 5549
DO ADD^RCDPAYER(IBIFN)
+27 ;Rebuild AR profile of comment transactions
+28 KILL ^TMP("RCJIB",$JOB),^UTILITY($JOB,"W")
DO TRN^RCJIBFN2(IBIFN)
End DoDot:1
+29 ;
+30 IF $DATA(^TMP("RCJIB",$JOB))
SET IBI=""
FOR
SET IBI=$ORDER(^TMP("RCJIB",$JOB,IBI))
if 'IBI
QUIT
Begin DoDot:1
+31 SET IBX=$GET(^TMP("RCJIB",$JOB,IBI))
IF $$STNO^RCJIBFN2(+$PIECE(IBX,U,3))'["COMMENT"
QUIT
+32 SET IBRCT5=$$N5^RCJIBFN1(IBI)
+33 SET IBSTR=""
SET IBLN=$$SET(IBSTR,IBLN)
+34 SET IBD=$PIECE(IBX,U,1)
SET IBSTR=$$SETLN(IBD,IBSTR,2,8)
+35 SET IBD=$$DATE(+$PIECE(IBX,U,2))
SET IBSTR=$$SETLN(IBD,IBSTR,14,8)
+36 SET IBD=$PIECE(IBRCT5,U,1)
SET IBSTR=$$SETLN(IBD,IBSTR,25,30)
+37 SET IBD="FOLLOW-UP DT: "_$$DATE(+$PIECE(IBRCT5,U,2))
SET IBSTR=$$SETLN(IBD,IBSTR,57,22)
+38 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
+39 ;HIPAA 5010 - check if this comment is contact data
+40 IF $PIECE(IBRCT5,U)["ERA Payer Contact Information"
Begin DoDot:2
+41 NEW CONTACT,PHONE,FAX,EMAIL,WEB,NAME,EXT,PAYER,HAVPAYER
+42 ;Display contact data IA 5549
+43 ; primary, secondary, and tertiary contact data need to be displayed. Display of contact data
+44 ; should only occur for each unique payer at BILL (B) x-ref of IBM(361.1,"B",IBIFN).
+45 ; evaluation starts with the most recent entry.
+46 ; Contact data belonging to more than one payer can be distinguished by payer name
+47 SET (HAVPAYER,IB3611)=""
+48 FOR
SET IB3611=$ORDER(^IBM(361.1,"B",IBIFN,IB3611),-1)
if 'IB3611
QUIT
SET CONTACT=$$EN^RCDPAYER(IB3611)
Begin DoDot:3
+49 if 'CONTACT
QUIT
+50 ;IA 4051
SET PAYER=$PIECE($GET(^IBM(361.1,IB3611,0)),U,2)
SET PAYER=$$EXTERNAL^DILFD(361.1,.02,,PAYER)
+51 ; payer contact data has already been displayed
if PAYER=HAVPAYER
QUIT
+52 SET HAVPAYER=PAYER
+53 SET FAX=$PIECE(CONTACT,U,5)
SET EMAIL=$PIECE(CONTACT,U,6)
SET WEB=$PIECE(CONTACT,U,3)
+54 SET PHONE=$PIECE(CONTACT,U,4)
SET EXT=$PIECE(CONTACT,U,7)
SET NAME=$PIECE(CONTACT,U,2)
+55 SET IBD="Payer Name: "_PAYER
+56 SET IBSTR=$$SETLN(IBD,IBSTR,25,78)
+57 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
+58 IF NAME]""
Begin DoDot:4
+59 SET IBD="Contact Name: "_NAME
+60 SET IBSTR=$$SETLN(IBD,IBSTR,25,78)
+61 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
End DoDot:4
+62 IF PHONE]""
Begin DoDot:4
+63 SET IBD="Phone Number: "_PHONE
if EXT]""
SET IBD=IBD_" Ext: "_EXT
+64 SET IBSTR=$$SETLN(IBD,IBSTR,25,78)
+65 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
End DoDot:4
+66 IF FAX]""
Begin DoDot:4
+67 SET IBD="Facsimile Number: "_FAX
+68 SET IBSTR=$$SETLN(IBD,IBSTR,25,78)
+69 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
End DoDot:4
+70 IF EMAIL]""
Begin DoDot:4
+71 SET IBD="Email Address: "_EMAIL
+72 SET IBSTR=$$SETLN(IBD,IBSTR,25,78)
+73 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
End DoDot:4
+74 IF WEB]""
Begin DoDot:4
+75 SET IBD="Website Address:"_$EXTRACT(WEB,1,40)
+76 SET IBSTR=$$SETLN(IBD,IBSTR,25,78)
+77 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
if $LENGTH(WEB)<41
QUIT
+78 SET IBSTR=$$SETLN($EXTRACT(WEB,41,96),IBSTR,25,78)
+79 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
if $LENGTH(WEB)<97
QUIT
+80 SET IBSTR=$$SETLN($EXTRACT(WEB,97,115),IBSTR,25,78)
+81 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
End DoDot:4
+82 SET IBLN=$$SET(IBSTR,IBLN)
End DoDot:3
End DoDot:2
+83 ;
+84 ; -- transaction comments (86)
+85 SET X=$PIECE($GET(^TMP("RCJIB",$JOB,IBI)),U,6)
IF X'=""
SET DIWL=1
SET DIWR=54
SET DIWF=""
DO ^DIWP
+86 ;
+87 ; -- comments (86 & 41)
+88 KILL COM
DO N7^RCJIBFN1(IBI)
IF $DATA(COM)>2
Begin DoDot:2
+89 SET IBJ=""
FOR
SET IBJ=$ORDER(COM(IBJ))
if 'IBJ
QUIT
SET X=$GET(COM(IBJ))
IF X'=""
SET DIWL=1
SET DIWR=54
SET DIWF=""
DO ^DIWP
End DoDot:2
+90 ;
+91 IF $DATA(^UTILITY($JOB,"W"))
SET (IBK,IBCNT)=0
FOR
SET IBK=$ORDER(^UTILITY($JOB,"W",1,IBK))
if 'IBK
QUIT
Begin DoDot:2
+92 SET IBD=$GET(^UTILITY($JOB,"W",1,IBK,0))
SET IBSTR=$$SETLN(IBD,IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
End DoDot:2
+93 KILL ^UTILITY($JOB,"W")
End DoDot:1
+94 KILL ^TMP("RCJIB",$JOB),^UTILITY($JOB,"W")
+95 ; MRA comments
+96 ; check if we have any comments to display
+97 IF $DATA(^DGCR(399,IBIFN,"TXC","B"))
Begin DoDot:1
+98 SET IBLN=$$SET("",IBLN)
+99 SET IBSTR=""
SET IBSTR=$$SETLN("MRA REQUEST CLAIM COMMENTS",IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
+100 SET IBSTR=""
SET IBSTR=$$SETLN("--------------------------",IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
+101 ; loop through all available comments
+102 SET IBDATE=""
FOR
SET IBDATE=$ORDER(^DGCR(399,IBIFN,"TXC","B",IBDATE),-1)
if IBDATE=""
QUIT
Begin DoDot:2
+103 SET IBZ=$ORDER(^DGCR(399,IBIFN,"TXC","B",IBDATE,""))
SET IB0=^DGCR(399,IBIFN,"TXC",IBZ,0)
SET IBDUZ=$PIECE(IB0,U,2)
+104 ;S IBLN=$$SET("",IBLN)
+105 SET IBSTR=""
+106 SET IBSTR=$$SETLN($$FMTE^XLFDT(IBDATE,"2Z"),IBSTR,14,8)
+107 SET IBSTR=$$SETLN($JUSTIFY("Entered by "_$$GET1^DIQ(200,IBDUZ,.01),54),IBSTR,25,54)
+108 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
+109 ; loop through comment lines
+110 SET CMLN=0
FOR
SET CMLN=$ORDER(^DGCR(399,IBIFN,"TXC",IBZ,1,CMLN))
if CMLN=""
QUIT
Begin DoDot:3
+111 SET X=^DGCR(399,IBIFN,"TXC",IBZ,1,CMLN,0)
IF X'=""
SET DIWL=1
SET DIWR=54
SET DIWF=""
DO ^DIWP
+112 QUIT
End DoDot:3
+113 IF $DATA(^UTILITY($JOB,"W"))
SET IBK=0
FOR
SET IBK=$ORDER(^UTILITY($JOB,"W",1,IBK))
if 'IBK
QUIT
Begin DoDot:3
+114 SET CMSTR=$GET(^UTILITY($JOB,"W",1,IBK,0))
SET IBSTR=$$SETLN(CMSTR,IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
+115 QUIT
End DoDot:3
+116 KILL ^UTILITY($JOB,"W")
+117 QUIT
End DoDot:2
+118 ;D CLEAN^DILF
+119 QUIT
End DoDot:1
+120 ; display RFAI Claim Comments right after MRA REQUEST CLAIM COMMENTS *IB*2.0*547
+121 DO RFAIC
+122 ; IB*2.0*432
DO EOBC
+123 ; IB*2.0*447 BI
DO MDACMTS
+124 DO CLEAN^DILF
+125 ;
+126 IF IBLN=0
SET IBLN=$$SET("",IBLN)
SET IBLN=$$SET("No Comment Transactions Exist For This Account.",IBLN)
+127 SET VALMCNT=IBLN
+128 QUIT
+129 ;
EOBC ; check for new EOB comments IB*2.0*432
+1 IF $DATA(^DGCR(399,IBIFN,"TXC2","B"))
Begin DoDot:1
+2 SET IBLN=$$SET("",IBLN)
+3 SET IBSTR=""
SET IBSTR=$$SETLN("COB MANAGMENT CLAIM COMMENTS",IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
+4 SET IBSTR=""
SET IBSTR=$$SETLN("----------------------------",IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
+5 ; loop through all available comments
+6 SET IBDATE=""
FOR
SET IBDATE=$ORDER(^DGCR(399,IBIFN,"TXC2","B",IBDATE),-1)
if IBDATE=""
QUIT
Begin DoDot:2
+7 SET IBZ=$ORDER(^DGCR(399,IBIFN,"TXC2","B",IBDATE,""))
SET IB0=^DGCR(399,IBIFN,"TXC2",IBZ,0)
SET IBDUZ=$PIECE(IB0,U,2)
+8 ;S IBLN=$$SET("",IBLN)
+9 SET IBSTR=""
+10 SET IBSTR=$$SETLN($$FMTE^XLFDT(IBDATE,"2Z"),IBSTR,14,8)
+11 SET IBSTR=$$SETLN($JUSTIFY("Entered by "_$$GET1^DIQ(200,IBDUZ,.01),54),IBSTR,25,54)
+12 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
+13 ; loop through comment lines
+14 SET CMLN=0
FOR
SET CMLN=$ORDER(^DGCR(399,IBIFN,"TXC2",IBZ,1,CMLN))
if CMLN=""
QUIT
Begin DoDot:3
+15 SET X=^DGCR(399,IBIFN,"TXC2",IBZ,1,CMLN,0)
IF X'=""
SET DIWL=1
SET DIWR=54
SET DIWF=""
DO ^DIWP
+16 QUIT
End DoDot:3
+17 IF $DATA(^UTILITY($JOB,"W"))
SET IBK=0
FOR
SET IBK=$ORDER(^UTILITY($JOB,"W",1,IBK))
if 'IBK
QUIT
Begin DoDot:3
+18 SET CMSTR=$GET(^UTILITY($JOB,"W",1,IBK,0))
SET IBSTR=$$SETLN(CMSTR,IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
+19 QUIT
End DoDot:3
+20 KILL ^UTILITY($JOB,"W")
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT
+24 ;
CONTACT() ;HIPAA 5010 check for contact data in comments
+1 NEW FOUND,IBI
+2 SET FOUND=0
SET IBI=""
+3 FOR
SET IBI=$ORDER(^TMP("RCJIB",$JOB,IBI))
if 'IBI
QUIT
Begin DoDot:1
+4 SET IBX=$GET(^TMP("RCJIB",$JOB,IBI))
if $$STNO^RCJIBFN2(+$PIECE(IBX,U,3))'["COMMENT"
QUIT
+5 if $PIECE($$N5^RCJIBFN1(IBI),U)["ERA Payer Contact Information"
SET FOUND=1
End DoDot:1
if FOUND
QUIT
+6 QUIT FOUND
+7 ;
DATE(X) ; date in external format
+1 NEW Y
SET Y=""
IF +X
SET Y=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+2 QUIT Y
+3 ;
SETLN(STR,IBX,COL,WD) ;
+1 SET IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
+2 QUIT IBX
+3 ;
SET(STR,LN) ; set up TMP array with screen data
+1 SET LN=LN+1
DO SET^VALM10(LN,STR)
SETQ QUIT LN
+1 ;
MDACMTS ; Check for MDA comments, Load for List Manager Screen IB*2.0*447 BI
+1 ; INTEGRATION CONTROL REGISTRATION is contained in DBIA #5696.
+2 DO MCOM^PRCAMDA2(IBIFN,.IBLN)
+3 QUIT
+4 ;
RFAIC ; check for new RFAI comments IB*2.0*547 (modeled after EOBC)
+1 ; uses ^IBA(368,"D",$E(X,1,30),DA) PATIENT CONTROL NUMBER [D] cross-reference
+2 ;
+3 if '$DATA(^IBA(368,"D",IBIFN))
QUIT
+4 NEW IBTNI,IBC,IBCLM,IBDUZ,IBDT,IBK,CMSTR,IBSTR,IBZ
+5 ; loop through all available comments
+6 SET IBC=0
SET IBTNI=""
FOR
SET IBTNI=$ORDER(^IBA(368,"D",IBIFN,IBTNI))
if IBTNI=""
QUIT
Begin DoDot:1
+7 ; not all transactions associated with a claim have comments
+8 if '$DATA(^IBA(368,IBTNI,201))
QUIT
+9 ; loop through all available comments
+10 SET IBDT=""
FOR
SET IBDT=$ORDER(^IBA(368,IBTNI,201,"B",IBDT),-1)
if IBDT=""
QUIT
Begin DoDot:2
+11 SET IBZ=$ORDER(^IBA(368,IBTNI,201,"B",IBDT,""))
SET IBDUZ=$PIECE($GET(^IBA(368,IBTNI,201,IBZ,0)),U,2)
SET IBC=IBC+1
+12 ; display header and underline prior to 1st transaction with comment only
+13 if IBC=1
Begin DoDot:3
+14 SET IBLN=$$SET("",IBLN)
+15 SET IBSTR=""
SET IBSTR=$$SETLN("RFAI CLAIM COMMENTS",IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
+16 SET IBSTR=""
SET IBSTR=$$SETLN("----------------------------",IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
End DoDot:3
+17 SET IBSTR=""
SET IBSTR=$$SETLN($$FMTE^XLFDT(IBDT,"2Z"),IBSTR,14,8)
SET IBSTR=$$SETLN($JUSTIFY("Entered by "_$$GET1^DIQ(200,IBDUZ,.01),54),IBSTR,25,54)
+18 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
+19 ; loop through comment lines
+20 SET IBCLM=0
FOR
SET IBCLM=$ORDER(^IBA(368,IBTNI,201,IBZ,1,IBCLM))
if IBCLM=""
QUIT
Begin DoDot:3
+21 SET X=$GET(^IBA(368,IBTNI,201,IBZ,1,IBCLM,0))
IF X'=""
SET DIWL=1
SET DIWR=54
SET DIWF=""
DO ^DIWP
End DoDot:3
+22 IF $DATA(^UTILITY($JOB,"W"))
SET IBK=0
FOR
SET IBK=$ORDER(^UTILITY($JOB,"W",1,IBK))
if 'IBK
QUIT
Begin DoDot:3
+23 SET CMSTR=$GET(^UTILITY($JOB,"W",1,IBK,0))
SET IBSTR=$$SETLN(CMSTR,IBSTR,25,54)
SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
End DoDot:3
+24 KILL ^UTILITY($JOB,"W")
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
