| [623] | 1 | IBJTRA1 ;ALB/AAS,ARH - TPI CT INSURANCE COMMUNICATIONS BUILD ; 4/1/95
 | 
|---|
 | 2 |  ;;2.0;INTEGRATED BILLING;**39,91,347**;21-MAR-94;Build 24
 | 
|---|
 | 3 |  ;;Per VHA Directive 2004-038, this routine should not be modified.
 | 
|---|
 | 4 |  ;
 | 
|---|
 | 5 |  ; copyed from IBTRC with modifications to show reviews for multiple events
 | 
|---|
 | 6 |  ;
 | 
|---|
 | 7 |  ;
 | 
|---|
 | 8 | BLD ; -- Build list of Insurance contacts, including reviews, appeals, and denials
 | 
|---|
 | 9 |  K ^TMP("IBJTRA",$J),^TMP("IBJTRADX",$J),IBJTA1,IBJTA2
 | 
|---|
 | 10 |  N X,IBI,IBJ,J,IBTRC,IBTRCD,IBTRCD1,IBJTEVNT,IBCNT,IBTRN,IBTRND,IBETYP,IBBEG
 | 
|---|
 | 11 |  S VALMSG=$$MSG^IBTUTL3(DFN)
 | 
|---|
 | 12 |  S (IBTRC,IBCNT,VALMCNT)=0,IBI=""
 | 
|---|
 | 13 |  D IFNTRN^IBJTU5(IBIFN,.IBJTA1,.IBJTA2)
 | 
|---|
 | 14 |  I 'IBJTA1 S IBCNT=1 D SET1(" ") S IBCNT=2 D SET1("No Claims Tracking Entries.") G BLDQ
 | 
|---|
 | 15 |  S IBJ=0 F  S IBJ=$O(IBJTA2(IBJ)) Q:'IBJ  S IBTRN=IBJTA2(IBJ) D
 | 
|---|
 | 16 |  .S IBTRND=$G(^IBT(356,IBTRN,0))
 | 
|---|
 | 17 |  .S IBJTEVNT="    "_$$EVNT(IBTRND)
 | 
|---|
 | 18 |  .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
 | 
|---|
 | 19 |  ..S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
 | 
|---|
 | 20 |  ..S IBTRCD1=$G(^IBT(356.2,+IBTRC,1))
 | 
|---|
 | 21 |  ..Q:'+$P(IBTRCD,"^",19)  ;quit if inactive
 | 
|---|
 | 22 |  ..S IBCNT=IBCNT+1
 | 
|---|
 | 23 |  ..I IBJTEVNT'="" D SET(" ",0),SET(IBJTEVNT,0) S IBJTEVNT=""
 | 
|---|
 | 24 |  ..S IBETYP=$G(^IBE(356.11,+$P(IBTRCD,"^",4),0))
 | 
|---|
 | 25 |  ..W "."
 | 
|---|
 | 26 |  ..S X=""
 | 
|---|
 | 27 |  ..S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
 | 
|---|
 | 28 |  ..S X=$$SETFLD^VALM1($P($$DAT1^IBOUTL(+IBTRCD,"2P")," "),X,"DATE")
 | 
|---|
 | 29 |  ..S X=$$SETFLD^VALM1($P($G(^DIC(36,+$P(IBTRCD,"^",8),0)),"^"),X,"INS CO")
 | 
|---|
 | 30 |  ..S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)),X,"ACTION")
 | 
|---|
 | 31 |  ..;
 | 
|---|
 | 32 |  ..S X=$$SETFLD^VALM1($P(IBETYP,"^",3),X,"TYPE")
 | 
|---|
 | 33 |  ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",28),X,"PRE-CERT")
 | 
|---|
 | 34 |  ..I $P(IBTRCD,"^",13) S X=$$SETFLD^VALM1($J($$DAY^IBTUTL3($P(IBTRCD,"^",12),$P(IBTRCD,"^",13),IBTRN),3),X,"DAYS")
 | 
|---|
 | 35 |  ..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")
 | 
|---|
 | 36 |  ..I $P(IBTRCD1,"^",7)!($P(IBTRCD1,"^",8)) S X=$$SETFLD^VALM1("ALL",X,"DAYS")
 | 
|---|
 | 37 |  ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",6),X,"CONTACT")
 | 
|---|
 | 38 |  ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",7),X,"PHONE")
 | 
|---|
 | 39 |  ..S X=$$SETFLD^VALM1($P(IBTRCD,"^",9),X,"REF NO")
 | 
|---|
 | 40 |  ..I $P(IBETYP,"^",2)=60!($P(IBETYP,"^",2)=65) D APPEAL^IBTRC3
 | 
|---|
 | 41 |  ..D SET(X,1)
 | 
|---|
 | 42 |  I 'IBCNT S IBCNT=1 D SET1(" ") S IBCNT=2 D SET1("No Insurance Reviews for Episodes on this Bill.") G BLDQ
 | 
|---|
 | 43 | BLDQ K IBJTA1,IBJTA2
 | 
|---|
 | 44 |  Q
 | 
|---|
 | 45 |  ;
 | 
|---|
 | 46 | SET1(X) ; set array (no selection)
 | 
|---|
 | 47 |  S VALMCNT=VALMCNT+1
 | 
|---|
 | 48 |  S ^TMP("IBJTRA",$J,VALMCNT,0)=X
 | 
|---|
 | 49 |  Q
 | 
|---|
 | 50 |  ;
 | 
|---|
 | 51 | SET(X,Y) ; -- set arrays
 | 
|---|
 | 52 |  S VALMCNT=VALMCNT+1
 | 
|---|
 | 53 |  S ^TMP("IBJTRA",$J,VALMCNT,0)=X
 | 
|---|
 | 54 |  S ^TMP("IBJTRA",$J,"IDX",VALMCNT,IBCNT)=""
 | 
|---|
 | 55 |  I +$G(Y) S ^TMP("IBJTRADX",$J,IBCNT)=VALMCNT_"^"_IBTRC
 | 
|---|
 | 56 |  Q
 | 
|---|
 | 57 |  ;
 | 
|---|
 | 58 | EVNT(IBTRND) ; return line for display on event
 | 
|---|
 | 59 |  N X,Y,IBTYP S X="" I $G(IBTRND)="" G EVNTQ
 | 
|---|
 | 60 |  S IBTYP=+$P(IBTRND,U,18)
 | 
|---|
 | 61 |  S X=$$EXSET^IBJU1(IBTYP,356,.18)
 | 
|---|
 | 62 |  I IBTYP=2 S X=X_" of "_$P($G(^DIC(40.7,+$$SCE^IBSDU(+$P(IBTRND,U,4),3),0)),U,1)
 | 
|---|
 | 63 |  I IBTYP=3 S Y=+$P($G(^RMPR(660,+$P(IBTRND,U,9),0)),U,6),X=X_" of "_$$EXSET^IBJU1(Y,660,4)
 | 
|---|
 | 64 |  I IBTYP=4 S X=X_" of "_$$FILE^IBRXUTL(+$P(IBTRND,U,8),.01)
 | 
|---|
 | 65 |  S X=X_" on "_$$DAT1^IBOUTL($P(IBTRND,U,6),"2P")
 | 
|---|
 | 66 | EVNTQ Q X
 | 
|---|