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

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1IBCRLT ;ALB/ARH - RATES: DISPLAY RATE TYPES ; 16-MAY-1996
2 ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for IBCR RATE TYPE
6 D EN^VALM("IBCR RATE TYPE")
7 Q
8 ;
9HDR ; -- header code
10 S VALMHDR(1)="This is a Standard file with entries released nationally."
11 Q
12 ;
13INIT ; -- init variables and list array
14 K ^TMP("IBCRLT",$J),^TMP("IBCRLTX1",$J)
15 D BLD
16 Q
17 ;
18HELP ; -- help code
19 S X="?" D DISP^XQORM1 W !!
20 Q
21 ;
22EXIT ; -- exit code
23 K ^TMP("IBCRLT",$J),^TMP("IBCRLTX1",$J)
24 D CLEAR^VALM1,CLEAN^VALM10
25 Q
26 ;
27BLD ; build array for rate type display
28 N IBRT,IBRTFN,IBCNT,IBTC,IBTW,IBSW,IBLR,IBLN,IBT,IBD,IBGRPB,IBGRPE S VALMCNT=0,IBCNT=0
29 ;
30 S (IBCNT,VALMCNT)=1
31 S IBTC(1)=2,IBTC(2)=39,IBTW(1)=15,IBTW(2)=16,IBSW(1)=21,IBSW(2)=25
32 ;
33 ; create LM display array
34 S IBRT="" F S IBRT=$O(^DGCR(399.3,"B",IBRT)) Q:IBRT="" D
35 . S IBRTFN=0 F S IBRTFN=$O(^DGCR(399.3,"B",IBRT,IBRTFN)) Q:'IBRTFN D
36 .. ;
37 .. S IBLN=$G(^DGCR(399.3,IBRTFN,0)) Q:IBLN="" D SETO(IBRTFN,IBCNT)
38 .. ;
39 .. S IBT="",IBD="" S IBCNT=$$SET(IBT,IBD,IBCNT,1)
40 .. S IBT="Rate Type: ",IBD=$P(IBLN,U,1) S IBCNT=$$SET(IBT,IBD,IBCNT,1)
41 .. D CNTRL^VALM10((IBCNT-1),(IBTC(1)+IBTW(1)),IBSW(1),IOINHI,IOINORM)
42 .. S IBGRPB=IBCNT,IBLR=1
43 .. ;
44 .. S IBT="Bill Name: ",IBD=$P(IBLN,U,2) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
45 .. S IBT="Abbreviation: ",IBD=$P(IBLN,U,4) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
46 .. S IBT="Third Party?: ",IBD=$S(+$P(IBLN,U,5):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
47 .. S IBT="Inactive: ",IBD=$S(+$P(IBLN,U,3):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
48 .. ;
49 .. S IBGRPE=IBCNT,IBCNT=IBGRPB,IBLR=2
50 .. ;
51 .. S IBT="AR Category: ",IBD=$$EXPAND^IBCRU1(399.3,.06,$P(IBLN,U,6)) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
52 .. S IBT="Who's Respns: ",IBD=$$EXPAND^IBCRU1(399.3,.07,$P(IBLN,U,7)) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
53 .. S IBT="RI Statement?: ",IBD=$S(+$P(IBLN,U,8):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
54 .. S IBT="NSC Statement?: ",IBD=$S(+$P(IBLN,U,9):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
55 .. S (IBCNT,VALMCNT)=$S(IBCNT>IBGRPE:IBCNT,1:IBGRPE)
56 ;
57 S (IBCNT,VALMCNT)=IBCNT-1
58 ;
59 I VALMCNT=0 S IBCNT=$$SET(" ","",1,1),IBCNT=$$SET("No Rate Types defined","",2,1)
60 ;
61 Q
62 ;
63SETO(RT,LN) ; set line number of beginning line of a rate type
64 ; (so when redisplay after edit it begins redisplay on the rate that was edited)
65 S ^TMP("IBCRLTX1",$J,+$G(RT))=+$G(LN)
66 Q
67 ;
68SET(TTL,DATA,LN,LR) ;
69 N IBY
70 S IBY=$J(TTL,IBTW(LR))_DATA D SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR)))
71 S LN=LN+1
72 Q LN
73 ;
74SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data
75 N IBX S IBX=$G(^TMP("IBCRLT",$J,LN,0))
76 S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
77 D SET^VALM10(LN,IBX) I $G(RV)'="" D CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
78 Q
Note: See TracBrowser for help on using the repository browser.