source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJTRA1.m@ 808

Last change on this file since 808 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 2.9 KB
RevLine 
[623]1IBJTRA1 ;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 ;
8BLD ; -- 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
43BLDQ K IBJTA1,IBJTA2
44 Q
45 ;
46SET1(X) ; set array (no selection)
47 S VALMCNT=VALMCNT+1
48 S ^TMP("IBJTRA",$J,VALMCNT,0)=X
49 Q
50 ;
51SET(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 ;
58EVNT(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")
66EVNTQ Q X
Note: See TracBrowser for help on using the repository browser.