IBJTRA1 ;ALB/AAS,ARH - TPI CT INSURANCE COMMUNICATIONS BUILD ; 4/1/95
;;2.0;INTEGRATED BILLING;**39,91,347,389,458**;21-MAR-94;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; copyed from IBTRC with modifications to show reviews for multiple events
;
;
BLD ; -- Build list of Insurance contacts, including reviews, appeals, and denials
K ^TMP("IBJTRA",$J),^TMP("IBJTRADX",$J),IBJTA1,IBJTA2
N X,IBI,IBJ,J,IBTRC,IBTRCD,IBTRCD1,IBJTEVNT,IBCNT,IBTRN,IBTRND,IBETYP,IBBEG
S VALMSG=$$MSG^IBTUTL3(DFN)
S (IBTRC,IBCNT,VALMCNT)=0,IBI=""
D IFNTRN^IBJTU5(IBIFN,.IBJTA1,.IBJTA2)
I 'IBJTA1 S IBCNT=1 D SET1(" ") S IBCNT=2 D SET1("No Claims Tracking Entries.") G BLDQ
S IBJ=0 F S IBJ=$O(IBJTA2(IBJ)) Q:'IBJ S IBTRN=IBJTA2(IBJ) D
.S IBTRND=$G(^IBT(356,IBTRN,0))
.S IBJTEVNT=" "_$$EVNT(IBTRND)
.F S IBI=$O(^IBT(356.2,"ATIDT",IBTRN,IBI)) Q:'IBI S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"ATIDT",IBTRN,IBI,IBTRC)) Q:'IBTRC D
..S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
..S IBTRCD1=$G(^IBT(356.2,+IBTRC,1))
..Q:'+$P(IBTRCD,"^",19) ;quit if inactive
..S IBCNT=IBCNT+1
..I IBJTEVNT'="" D SET(" ",0),SET(IBJTEVNT,0) S IBJTEVNT=""
..S IBETYP=$G(^IBE(356.11,+$P(IBTRCD,"^",4),0))
..W "."
..S X=""
..S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
..S X=$$SETFLD^VALM1($P($$DAT1^IBOUTL(+IBTRCD,"2P")," "),X,"DATE")
..S X=$$SETFLD^VALM1($P($G(^DIC(36,+$P(IBTRCD,"^",8),0)),"^"),X,"INS CO")
..S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)),X,"ACTION")
..;
..S X=$$SETFLD^VALM1($P(IBETYP,"^",3),X,"TYPE")
..S X=$$SETFLD^VALM1($$AUTHN^IBTRC(IBTRC,10),X,"PRE-CERT")
..I $P(IBTRCD,"^",13) S X=$$SETFLD^VALM1($J($$DAY^IBTUTL3($P(IBTRCD,"^",12),$P(IBTRCD,"^",13),IBTRN),3),X,"DAYS")
..I $P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^",3)=20 S X=$$SETFLD^VALM1($J($$DAY^IBTUTL3($P(IBTRCD,"^",15),$P(IBTRCD,"^",16),IBTRN),3),X,"DAYS")
..I $P(IBTRCD1,"^",7)!($P(IBTRCD1,"^",8)) S X=$$SETFLD^VALM1("ALL",X,"DAYS")
..S X=$$SETFLD^VALM1($P(IBTRCD,"^",6),X,"CONTACT")
..S X=$$SETFLD^VALM1($P(IBTRCD,"^",7),X,"PHONE")
..S X=$$SETFLD^VALM1($$CREFN^IBTRC(IBTRC,12),X,"REF NO")
..I $P(IBETYP,"^",2)=60!($P(IBETYP,"^",2)=65) D APPEAL^IBTRC3
..D SET(X,1)
I 'IBCNT S IBCNT=1 D SET1(" ") S IBCNT=2 D SET1("No Insurance Reviews for Episodes on this Bill.") G BLDQ
BLDQ K IBJTA1,IBJTA2
Q
;
SET1(X) ; set array (no selection)
S VALMCNT=VALMCNT+1
S ^TMP("IBJTRA",$J,VALMCNT,0)=X
Q
;
SET(X,Y) ; -- set arrays
S VALMCNT=VALMCNT+1
S ^TMP("IBJTRA",$J,VALMCNT,0)=X
S ^TMP("IBJTRA",$J,"IDX",VALMCNT,IBCNT)=""
I +$G(Y) S ^TMP("IBJTRADX",$J,IBCNT)=VALMCNT_"^"_IBTRC
Q
;
EVNT(IBTRND) ; return line for display on event
N X,Y,IBTYP S X="" I $G(IBTRND)="" G EVNTQ
S IBTYP=+$P(IBTRND,U,18)
S X=$$EXSET^IBJU1(IBTYP,356,.18)
I IBTYP=2 S X=X_" of "_$P($G(^DIC(40.7,+$$SCE^IBSDU(+$P(IBTRND,U,4),3),0)),U,1)
I IBTYP=3 S X=X_" of "_$P($$PIN^IBCSC5B(+$P(IBTRND,U,9)),U,2)
I IBTYP=4 S X=X_" of "_$$FILE^IBRXUTL(+$P(IBTRND,U,8),.01)
S X=X_" on "_$$DAT1^IBOUTL($P(IBTRND,U,6),"2P")
EVNTQ Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTRA1 3067 printed Dec 13, 2024@02:24:05 Page 2
IBJTRA1 ;ALB/AAS,ARH - TPI CT INSURANCE COMMUNICATIONS BUILD ; 4/1/95
+1 ;;2.0;INTEGRATED BILLING;**39,91,347,389,458**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; copyed from IBTRC with modifications to show reviews for multiple events
+5 ;
+6 ;
BLD ; -- Build list of Insurance contacts, including reviews, appeals, and denials
+1 KILL ^TMP("IBJTRA",$JOB),^TMP("IBJTRADX",$JOB),IBJTA1,IBJTA2
+2 NEW X,IBI,IBJ,J,IBTRC,IBTRCD,IBTRCD1,IBJTEVNT,IBCNT,IBTRN,IBTRND,IBETYP,IBBEG
+3 SET VALMSG=$$MSG^IBTUTL3(DFN)
+4 SET (IBTRC,IBCNT,VALMCNT)=0
SET IBI=""
+5 DO IFNTRN^IBJTU5(IBIFN,.IBJTA1,.IBJTA2)
+6 IF 'IBJTA1
SET IBCNT=1
DO SET1(" ")
SET IBCNT=2
DO SET1("No Claims Tracking Entries.")
GOTO BLDQ
+7 SET IBJ=0
FOR
SET IBJ=$ORDER(IBJTA2(IBJ))
if 'IBJ
QUIT
SET IBTRN=IBJTA2(IBJ)
Begin DoDot:1
+8 SET IBTRND=$GET(^IBT(356,IBTRN,0))
+9 SET IBJTEVNT=" "_$$EVNT(IBTRND)
+10 FOR
SET IBI=$ORDER(^IBT(356.2,"ATIDT",IBTRN,IBI))
if 'IBI
QUIT
SET IBTRC=0
FOR
SET IBTRC=$ORDER(^IBT(356.2,"ATIDT",IBTRN,IBI,IBTRC))
if 'IBTRC
QUIT
Begin DoDot:2
+11 SET IBTRCD=$GET(^IBT(356.2,+IBTRC,0))
+12 SET IBTRCD1=$GET(^IBT(356.2,+IBTRC,1))
+13 ;quit if inactive
if '+$PIECE(IBTRCD,"^",19)
QUIT
+14 SET IBCNT=IBCNT+1
+15 IF IBJTEVNT'=""
DO SET(" ",0)
DO SET(IBJTEVNT,0)
SET IBJTEVNT=""
+16 SET IBETYP=$GET(^IBE(356.11,+$PIECE(IBTRCD,"^",4),0))
+17 WRITE "."
+18 SET X=""
+19 SET X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
+20 SET X=$$SETFLD^VALM1($PIECE($$DAT1^IBOUTL(+IBTRCD,"2P")," "),X,"DATE")
+21 SET X=$$SETFLD^VALM1($PIECE($GET(^DIC(36,+$PIECE(IBTRCD,"^",8),0)),"^"),X,"INS CO")
+22 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.11,$PIECE(IBTRCD,"^",11)),X,"ACTION")
+23 ;
+24 SET X=$$SETFLD^VALM1($PIECE(IBETYP,"^",3),X,"TYPE")
+25 SET X=$$SETFLD^VALM1($$AUTHN^IBTRC(IBTRC,10),X,"PRE-CERT")
+26 IF $PIECE(IBTRCD,"^",13)
SET X=$$SETFLD^VALM1($JUSTIFY($$DAY^IBTUTL3($PIECE(IBTRCD,"^",12),$PIECE(IBTRCD,"^",13),IBTRN),3),X,"DAYS")
+27 IF $PIECE($GET(^IBE(356.7,+$PIECE(IBTRCD,"^",11),0)),"^",3)=20
SET X=$$SETFLD^VALM1($JUSTIFY($$DAY^IBTUTL3($PIECE(IBTRCD,"^",15),$PIECE(IBTRCD,"^",16),IBTRN),3),X,"DAYS")
+28 IF $PIECE(IBTRCD1,"^",7)!($PIECE(IBTRCD1,"^",8))
SET X=$$SETFLD^VALM1("ALL",X,"DAYS")
+29 SET X=$$SETFLD^VALM1($PIECE(IBTRCD,"^",6),X,"CONTACT")
+30 SET X=$$SETFLD^VALM1($PIECE(IBTRCD,"^",7),X,"PHONE")
+31 SET X=$$SETFLD^VALM1($$CREFN^IBTRC(IBTRC,12),X,"REF NO")
+32 IF $PIECE(IBETYP,"^",2)=60!($PIECE(IBETYP,"^",2)=65)
DO APPEAL^IBTRC3
+33 DO SET(X,1)
End DoDot:2
End DoDot:1
+34 IF 'IBCNT
SET IBCNT=1
DO SET1(" ")
SET IBCNT=2
DO SET1("No Insurance Reviews for Episodes on this Bill.")
GOTO BLDQ
BLDQ KILL IBJTA1,IBJTA2
+1 QUIT
+2 ;
SET1(X) ; set array (no selection)
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBJTRA",$JOB,VALMCNT,0)=X
+3 QUIT
+4 ;
SET(X,Y) ; -- set arrays
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBJTRA",$JOB,VALMCNT,0)=X
+3 SET ^TMP("IBJTRA",$JOB,"IDX",VALMCNT,IBCNT)=""
+4 IF +$GET(Y)
SET ^TMP("IBJTRADX",$JOB,IBCNT)=VALMCNT_"^"_IBTRC
+5 QUIT
+6 ;
EVNT(IBTRND) ; return line for display on event
+1 NEW X,Y,IBTYP
SET X=""
IF $GET(IBTRND)=""
GOTO EVNTQ
+2 SET IBTYP=+$PIECE(IBTRND,U,18)
+3 SET X=$$EXSET^IBJU1(IBTYP,356,.18)
+4 IF IBTYP=2
SET X=X_" of "_$PIECE($GET(^DIC(40.7,+$$SCE^IBSDU(+$PIECE(IBTRND,U,4),3),0)),U,1)
+5 IF IBTYP=3
SET X=X_" of "_$PIECE($$PIN^IBCSC5B(+$PIECE(IBTRND,U,9)),U,2)
+6 IF IBTYP=4
SET X=X_" of "_$$FILE^IBRXUTL(+$PIECE(IBTRND,U,8),.01)
+7 SET X=X_" on "_$$DAT1^IBOUTL($PIECE(IBTRND,U,6),"2P")
EVNTQ QUIT X
