- 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 Mar 13, 2025@21:29:03 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
