source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJTLA1.m@ 1608

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1IBJTLA1 ;ALB/ARH - TPI ACTIVE BILLS LIST BUILD ;2/14/95
2 ;;2.0;INTEGRATED BILLING;**39,80,61,51,153,137,183,276**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5BLDA ; build active list for third party joint inquiry active list
6 N IBIFN,IBCNT S VALMCNT=0,IBCNT=0
7 S IBIFN=0 F S IBIFN=$O(^DGCR(399,"C",DFN,IBIFN)) Q:'IBIFN I $$ACTIVE^IBJTU4(IBIFN) W "." D SCRN
8 ;
9 I VALMCNT=0 D SET(" ",0),SET("No Active Bills for this Patient",0)
10 ;
11 Q
12 ;
13SCRN ; add bill to screen list (IBIFN,DFN must be defined)
14 N X,IBY,IBD0,IBDU,IBDM S X=""
15 S IBCNT=IBCNT+1,IBD0=$G(^DGCR(399,+IBIFN,0)),IBDU=$G(^DGCR(399,+IBIFN,"U")),IBDM=$G(^DGCR(399,+IBIFN,"M"))
16 S IBY=IBCNT,X=$$SETFLD^VALM1(IBY,X,"NUMBER")
17 S IBY=$P(IBD0,U,1)_$$ECME^IBTRE(IBIFN),X=$$SETFLD^VALM1(IBY,X,"BILL")
18 S IBY=$S($$REF^IBJTU31(+IBIFN):"r",1:""),X=$$SETFLD^VALM1(IBY,X,"REFER")
19 S IBY=$S($$IB^IBRUTL(+IBIFN,0):"*",1:""),X=$$SETFLD^VALM1(IBY,X,"HD")
20 S IBY=$$DATE($P(IBDU,U,1)),X=$$SETFLD^VALM1(IBY,X,"STFROM")
21 S IBY=$$DATE($P(IBDU,U,2)),X=$$SETFLD^VALM1(IBY,X,"STTO")
22 ;
23 S IBY=$P($$LST^DGMTU(DFN,$P(IBDU,U)),U,4),IBY=$S(IBY="C":"YES",IBY="P":"PEN",IBY="R":"REQ",IBY="G":"GMT",1:"NO"),X=$$SETFLD^VALM1(IBY,X,"MT?")
24 S IBY=$$TYPE($P(IBD0,U,5))_$$TF($P(IBD0,U,6)),X=$$SETFLD^VALM1(IBY,X,"TYPE")
25 S IBY=" "_$P($$ARSTATA^IBJTU4(IBIFN),U,2),X=$$SETFLD^VALM1(IBY,X,"ARST")
26 ;
27 S IBY=$P($G(^DGCR(399.3,+$P(IBD0,U,7),0)),U,4),X=$$SETFLD^VALM1(IBY,X,"RATE")
28 S IBY=$S($$MINS^IBJTU31(+IBIFN):"+",1:""),X=$$SETFLD^VALM1(IBY,X,"CB")
29 S IBY=+$G(^DGCR(399,+IBIFN,"MP"))
30 I 'IBY,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBY=+$$CURR^IBCEF2(IBIFN)
31 S IBY=$P($G(^DIC(36,+IBY,0)),U,1)
32 S X=$$SETFLD^VALM1(IBY,X,"INSUR")
33 S IBY=$$BILL^RCJIBFN2(IBIFN)
34 S X=$$SETFLD^VALM1($J(+$P(IBY,U,1),8,2),X,"OAMT")
35 S X=$$SETFLD^VALM1($J(+$P(IBY,U,3),8,2),X,"CAMT")
36 D SET(X,IBCNT)
37 Q
38 ;
39DATE(X) ; date in external format
40 N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
41 Q Y
42 ;
43TYPE(X) ; return abbreviated form of Bill Classification (399,.05)
44 Q $S(X=1:"IP",X=2:"IH",X=3:"OP",X=4:"OH",1:"")
45 ;
46TF(X) ; return abbreviated form of Timeframe of Bill (399,.06)
47 Q $S(X=2:"-F",X=3:"-C",X=4:"-L",X'=1:"-O",1:"")
48 ;
49SET(X,CNT) ; set up list manager screen array
50 S VALMCNT=VALMCNT+1
51 S ^TMP("IBJTLA",$J,VALMCNT,0)=X Q:'CNT
52 S ^TMP("IBJTLA",$J,"IDX",VALMCNT,+CNT)=""
53 S ^TMP("IBJTLAX",$J,CNT)=VALMCNT_U_IBIFN
54 Q
55 ;
Note: See TracBrowser for help on using the repository browser.