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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1IBJTTC ;ALB/ARH - TPI AR COMMENT HISTORY ; 06-MAR-1995
2 ;;2.0;INTEGRATED BILLING;**39,377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; AR Profile of Comments: This screen prints the following Comments:
6 ; Bill Comments (430,98) - entered during auditing
7 ; For each COMMENT Transaction:
8 ; Brief Comment (433,5.02)
9 ; Transaction Comment (433,86)
10 ; Comment (433,41)
11 ;
12EN ; -- main entry point for IBJT AR COMMENT HISTORY
13 D EN^VALM("IBJT AR COMMENT HISTORY")
14 Q
15 ;
16HDR ; -- header code
17 D HDR^IBJTU1(+IBIFN,+DFN,13)
18 Q
19 ;
20INIT ; -- init variables and list array
21 K ^TMP("IBJTTC",$J)
22 I '$G(DFN)!'$G(IBIFN) S VALMQUIT="" G INITQ
23 D BLD
24INITQ Q
25 ;
26HELP ; -- help code
27 S X="?" D DISP^XQORM1 W !!
28 Q
29 ;
30EXIT ; -- exit code
31 K ^TMP("IBJTTC",$J)
32 D CLEAR^VALM1
33 Q
34 ;
35BLD ;
36 N CMLN,CMSTR,X,IBCNT,IBZ,IB0,IBI,IBX,IBD,IBDATE,IBDUZ,IBRCT5,IBLN,IBSTR,IBK,IBJ,DIWL,DIWR,DIWF,COM
37 ;
38 S VALMCNT=0,IBLN=0
39 ;
40 ; Bill Comments (430,98)
41 K COM,^UTILITY($J,"W") D BCOM^RCJIBFN2(IBIFN) I $D(COM)>10 D
42 . S IBSTR="",IBD="AR BILL COMMENTS:" S IBSTR=$$SETLN(IBD,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
43 . ;
44 . S IBJ="" F S IBJ=$O(COM(IBJ)) Q:'IBJ S X=$G(COM(IBJ)) I X'="" S DIWL=1,DIWR=54,DIWF="" D ^DIWP
45 . ;
46 . I $D(^UTILITY($J,"W")) S (IBK,IBCNT)=0 F S IBK=$O(^UTILITY($J,"W",1,IBK)) Q:'IBK D
47 .. S IBD=$G(^UTILITY($J,"W",1,IBK,0)) S IBSTR=$$SETLN(IBD,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
48 . K ^UTILITY($J,"W")
49 ;
50 ; AR profile of comment transactions (433: 5.02, 41, 86)
51 K ^TMP("RCJIB",$J),^UTILITY($J,"W") D TRN^RCJIBFN2(IBIFN)
52 I $D(^TMP("RCJIB",$J)) S IBI="" F S IBI=$O(^TMP("RCJIB",$J,IBI)) Q:'IBI D
53 . S IBX=$G(^TMP("RCJIB",$J,IBI)) I $$STNO^RCJIBFN2(+$P(IBX,U,3))'["COMMENT" Q
54 . S IBRCT5=$$N5^RCJIBFN1(IBI)
55 . S IBSTR="",IBLN=$$SET(IBSTR,IBLN)
56 . S IBD=$P(IBX,U,1) S IBSTR=$$SETLN(IBD,IBSTR,2,8)
57 . S IBD=$$DATE(+$P(IBX,U,2)) S IBSTR=$$SETLN(IBD,IBSTR,14,8)
58 . S IBD=$P(IBRCT5,U,1) S IBSTR=$$SETLN(IBD,IBSTR,25,30)
59 . S IBD="FOLLOW-UP DT: "_$$DATE(+$P(IBRCT5,U,2)) S IBSTR=$$SETLN(IBD,IBSTR,57,22)
60 . S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
61 . ;
62 . ; -- transaction comments (86)
63 . S X=$P($G(^TMP("RCJIB",$J,IBI)),U,6) I X'="" S DIWL=1,DIWR=54,DIWF="" D ^DIWP
64 . ;
65 . ; -- comments (86 & 41)
66 . K COM D N7^RCJIBFN1(IBI) I $D(COM)>2 D
67 .. S IBJ="" F S IBJ=$O(COM(IBJ)) Q:'IBJ S X=$G(COM(IBJ)) I X'="" S DIWL=1,DIWR=54,DIWF="" D ^DIWP
68 . ;
69 . I $D(^UTILITY($J,"W")) S (IBK,IBCNT)=0 F S IBK=$O(^UTILITY($J,"W",1,IBK)) Q:'IBK D
70 .. S IBD=$G(^UTILITY($J,"W",1,IBK,0)) S IBSTR=$$SETLN(IBD,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
71 . K ^UTILITY($J,"W")
72 K ^TMP("RCJIB",$J),^UTILITY($J,"W")
73 ; MRA comments
74 ; check if we have any comments to display
75 I $D(^DGCR(399,IBIFN,"TXC","B")) D
76 .S IBLN=$$SET("",IBLN)
77 .S IBSTR="",IBSTR=$$SETLN("MRA REQUEST CLAIM COMMENTS",IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
78 .S IBSTR="",IBSTR=$$SETLN("--------------------------",IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
79 .; loop through all available comments
80 .S IBDATE="" F S IBDATE=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE),-1) Q:IBDATE="" D
81 ..S IBZ=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE,"")),IB0=^DGCR(399,IBIFN,"TXC",IBZ,0),IBDUZ=$P(IB0,U,2)
82 ..S IBLN=$$SET("",IBLN)
83 ..S IBSTR=""
84 ..S IBSTR=$$SETLN($$FMTE^XLFDT(IBDATE,"2Z"),IBSTR,14,8)
85 ..S IBSTR=$$SETLN($J("Entered by "_$$GET1^DIQ(200,IBDUZ,.01),54),IBSTR,25,54)
86 ..S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
87 ..; loop through comment lines
88 ..S CMLN=0 F S CMLN=$O(^DGCR(399,IBIFN,"TXC",IBZ,1,CMLN)) Q:CMLN="" D
89 ...S X=^DGCR(399,IBIFN,"TXC",IBZ,1,CMLN,0) I X'="" S DIWL=1,DIWR=54,DIWF="" D ^DIWP
90 ...Q
91 ..I $D(^UTILITY($J,"W")) S IBK=0 F S IBK=$O(^UTILITY($J,"W",1,IBK)) Q:'IBK D
92 ...S CMSTR=$G(^UTILITY($J,"W",1,IBK,0)) S IBSTR=$$SETLN(CMSTR,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
93 ...Q
94 ..K ^UTILITY($J,"W")
95 ..Q
96 .D CLEAN^DILF
97 .Q
98 ;
99 I IBLN=0 S IBLN=$$SET("",IBLN),IBLN=$$SET("No Comment Transactions Exist For This Account.",IBLN)
100 S VALMCNT=IBLN
101 Q
102 ;
103DATE(X) ; date in external format
104 N Y S Y="" I +X S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
105 Q Y
106 ;
107SETLN(STR,IBX,COL,WD) ;
108 S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
109 Q IBX
110 ;
111SET(STR,LN) ; set up TMP array with screen data
112 S LN=LN+1 D SET^VALM10(LN,STR)
113SETQ Q LN
Note: See TracBrowser for help on using the repository browser.