- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJTTC.m
r613 r623 1 IBJTTC ;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 ; 12 EN ; -- main entry point for IBJT AR COMMENT HISTORY 13 D EN^VALM("IBJT AR COMMENT HISTORY") 14 Q 15 ; 16 HDR ; -- header code 17 D HDR^IBJTU1(+IBIFN,+DFN,13) 18 Q 19 ; 20 INIT ; -- init variables and list array 21 K ^TMP("IBJTTC",$J) 22 I '$G(DFN)!'$G(IBIFN) S VALMQUIT="" G INITQ 23 D BLD 24 INITQ Q 25 ; 26 HELP ; -- help code 27 S X="?" D DISP^XQORM1 W !! 28 Q 29 ; 30 EXIT ; -- exit code 31 K ^TMP("IBJTTC",$J) 32 D CLEAR^VALM1 33 Q 34 ; 35 BLD ; 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 ; 103 DATE(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 ; 107 SETLN(STR,IBX,COL,WD) ; 108 S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD) 109 Q IBX 110 ; 111 SET(STR,LN) ; set up TMP array with screen data 112 S LN=LN+1 D SET^VALM10(LN,STR) 113 SETQ Q LN 1 IBJTTC ;ALB/ARH - TPI AR COMMENT HISTORY ; 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 ; 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 ; 12 EN ; -- main entry point for IBJT AR COMMENT HISTORY 13 D EN^VALM("IBJT AR COMMENT HISTORY") 14 Q 15 ; 16 HDR ; -- header code 17 D HDR^IBJTU1(+IBIFN,+DFN,13) 18 Q 19 ; 20 INIT ; -- init variables and list array 21 K ^TMP("IBJTTC",$J) 22 I '$G(DFN)!'$G(IBIFN) S VALMQUIT="" G INITQ 23 D BLD 24 INITQ Q 25 ; 26 HELP ; -- help code 27 S X="?" D DISP^XQORM1 W !! 28 Q 29 ; 30 EXIT ; -- exit code 31 K ^TMP("IBJTTC",$J) 32 D CLEAR^VALM1 33 Q 34 ; 35 BLD ; 36 N X,IBCNT,IBI,IBX,IBD,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 ; 74 I IBLN=0 S IBLN=$$SET("",IBLN),IBLN=$$SET("No Comment Transactions Exist For This Account.",IBLN) 75 S VALMCNT=IBLN 76 Q 77 ; 78 DATE(X) ; date in external format 79 N Y S Y="" I +X S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) 80 Q Y 81 ; 82 SETLN(STR,IBX,COL,WD) ; 83 S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD) 84 Q IBX 85 ; 86 SET(STR,LN) ; set up TMP array with screen data 87 S LN=LN+1 D SET^VALM10(LN,STR) 88 SETQ Q LN
Note:
See TracChangeset
for help on using the changeset viewer.
