| 1 | IBCRLT ;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 |  ;
 | 
|---|
| 5 | EN ; -- main entry point for IBCR RATE TYPE
 | 
|---|
| 6 |  D EN^VALM("IBCR RATE TYPE")
 | 
|---|
| 7 |  Q
 | 
|---|
| 8 |  ;
 | 
|---|
| 9 | HDR ; -- header code
 | 
|---|
| 10 |  S VALMHDR(1)="This is a Standard file with entries released nationally."
 | 
|---|
| 11 |  Q
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 | INIT ; -- init variables and list array
 | 
|---|
| 14 |  K ^TMP("IBCRLT",$J),^TMP("IBCRLTX1",$J)
 | 
|---|
| 15 |  D BLD
 | 
|---|
| 16 |  Q
 | 
|---|
| 17 |  ;
 | 
|---|
| 18 | HELP ; -- help code
 | 
|---|
| 19 |  S X="?" D DISP^XQORM1 W !!
 | 
|---|
| 20 |  Q
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 | EXIT ; -- exit code
 | 
|---|
| 23 |  K ^TMP("IBCRLT",$J),^TMP("IBCRLTX1",$J)
 | 
|---|
| 24 |  D CLEAR^VALM1,CLEAN^VALM10
 | 
|---|
| 25 |  Q
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 | BLD ; 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 |  ;
 | 
|---|
| 63 | SETO(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 |  ;
 | 
|---|
| 68 | SET(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 |  ;
 | 
|---|
| 74 | SET1(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
 | 
|---|