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

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1IBJTTA1 ;ALB/ARH - TPI AR ACCOUNT/CLAIM PROFILE BUILD ; 06-MAR-1995
2 ;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5BLD ;
6 N X,IBY,IBS,IBI,IBD0,IBDS,IBDU1,IBCNT,IBLN,IBAR
7 S IBD0=$G(^DGCR(399,+IBIFN,0)),IBDS=$G(^DGCR(399,+IBIFN,"S")),IBDU1=$G(^DGCR(399,+IBIFN,"U1"))
8 S IBAR=$$BILL^RCJIBFN2(IBIFN)
9 ;
10 S VALMCNT=0,IBCNT=0,X=""
11 ;
12 ; original bill
13 ;
14 S IBS=$P(IBD0,U,13),(IBI,IBY)="" D
15 . I IBS=1 S IBI="ENTERED",IBY=$P(IBDS,U,1) Q
16 . I IBS=2 S IBI="REVIEWED",IBY=$P(IBDS,U,4) S:$P(IBDS,U,7)>IBY IBI="REVIEWED (2nd)",IBY=$P(IBDS,U,7) Q
17 . I IBS=3 S IBI="AUTHORIZED",IBY=$P(IBDS,U,10) Q
18 . I IBS=4 S IBI="PRINTED (First)",IBY=$P(IBDS,U,12) S:$P(IBDS,U,14)>IBY IBI="PRINTED (Last)",IBY=$P(IBDS,U,14) Q
19 . I IBS=5 S IBI="TRANSMITTED",IBY="" Q
20 . I IBS=7 S IBI="CANCELLED",IBY=$P(IBDS,U,17) Q
21 . I IBS=0 S IBI="CLOSED",IBY="" Q
22 S IBY=$$DATE(IBY),X=$$SETFLD^VALM1(IBY,X,"DATE")
23 S IBY="IB Status: "_IBI,X=$$SETFLD^VALM1(IBY,X,"TRTY")
24 ;
25 S IBY=+IBDU1-$P(IBDU1,U,2),IBY=$J(IBY,11,2),X=$$SETFLD^VALM1(IBY,X,"TAMT")
26 S IBY=$P(IBAR,U,1),IBY=$J(IBY,11,2),X=$$SETFLD^VALM1(IBY,X,"CAMT")
27 D SET(X)
28 ;
29 ; AR profile of transactions
30 ;
31 D TRN^RCJIBFN2(IBIFN)
32 I $D(^TMP("RCJIB",$J)) S IBI=0 F S IBI=$O(^TMP("RCJIB",$J,IBI)) Q:'IBI D
33 . S IBLN=^TMP("RCJIB",$J,IBI)
34 . S IBY=IBCNT+1,X=$$SETFLD^VALM1(IBY,X,"NUMBER")
35 . S IBY=$P(IBLN,U,1),X=$$SETFLD^VALM1(IBY,X,"TRNUM")
36 . S IBY=$$DATE(+$P(IBLN,U,2)),X=$$SETFLD^VALM1(IBY,X,"DATE")
37 . S IBY=$P($$STNO^RCJIBFN2(+$P(IBLN,U,3)),U,1),X=$$SETFLD^VALM1(IBY,X,"TRTY")
38 . S IBY=$J($P(IBLN,U,4),11,2),X=$$SETFLD^VALM1(IBY,X,"TAMT")
39 . S IBY=$J($P(IBLN,U,5),11,2),X=$$SETFLD^VALM1(IBY,X,"CAMT")
40 . D SET(X,+IBI)
41 ;
42 D SET("") D SET("")
43 S X=" Total Collected: "_$J(+$P(IBAR,U,4),10,2) D SET(X)
44 I +$P(IBAR,U,5) S X=" Percent Collected: "_$J($P(IBAR,U,5),10,2)_"%" D SET(X)
45 ;
46 ; reason cancelled
47 I +$P(IBDS,U,18) K IBY D RCANC^IBJTU2(IBIFN,.IBY,47) I +IBY D
48 . S X=" Reason Cancelled by ("_$P(IBY,U,3)_"): ",X=X_$J(" ",(32-$L(X)))
49 . S IBI=0 F S IBI=$O(IBY(IBI)) Q:'IBI S X=X_IBY(IBI) D SET(X) S X=$J(" ",32)
50 ;
51 K ^TMP("RCJIB",$J) I '$D(^TMP("IBJTTAX",$J)) K ^TMP("IBJTTA",$J,"IDX")
52 Q
53 ;
54DATE(X) ; date in external format
55 N Y S Y="" I $G(X)?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
56 Q Y
57 ;
58SET(X,TRNS) ; set up list manager screen array
59 S VALMCNT=VALMCNT+1 N CNT
60 S:+$G(TRNS) IBCNT=IBCNT+1 S CNT=$S(+IBCNT:IBCNT,1:1)
61 S ^TMP("IBJTTA",$J,VALMCNT,0)=X
62 S ^TMP("IBJTTA",$J,"IDX",VALMCNT,+CNT)=""
63 S:$G(TRNS) ^TMP("IBJTTAX",$J,CNT)=VALMCNT_U_IBIFN_U_$G(TRNS)
64 Q
Note: See TracBrowser for help on using the repository browser.