[613] | 1 | IBJTBB ;ALB/ARH - TPI BILL DIAGNOSIS SCREEN ;01-MAR-1995
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**39,210**;21-MAR-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | EN ; -- main entry point for IBJ TP BILL DX
|
---|
| 6 | D EN^VALM("IBJT BILL DX")
|
---|
| 7 | Q
|
---|
| 8 | ;
|
---|
| 9 | HDR ; -- header code
|
---|
| 10 | D HDR^IBJTU1(+IBIFN,+DFN,12)
|
---|
| 11 | Q
|
---|
| 12 | ;
|
---|
| 13 | INIT ; -- init variables and list array
|
---|
| 14 | K ^TMP("IBJTBB",$J) N IBFT
|
---|
| 15 | I '$G(DFN)!'$G(IBIFN) S VALMQUIT="" G INITQ
|
---|
| 16 | D BLD
|
---|
| 17 | INITQ Q
|
---|
| 18 | ;
|
---|
| 19 | HELP ; -- help code
|
---|
| 20 | S X="?" D DISP^XQORM1 W !!
|
---|
| 21 | Q
|
---|
| 22 | ;
|
---|
| 23 | EXIT ; -- exit code
|
---|
| 24 | K ^TMP("IBJTBB",$J)
|
---|
| 25 | D CLEAR^VALM1
|
---|
| 26 | Q
|
---|
| 27 | ;
|
---|
| 28 | BLD ;
|
---|
| 29 | N IBADX,IBI,IBX,IBCNT,IBLN,IBSTR,IBDATE
|
---|
| 30 | S IBDATE=$$BDATE^IBACSV(IBIFN)
|
---|
| 31 | D SET^IBCSC4D(IBIFN,"",.IBADX) I $D(IBADX)'>1 S IBLN=1 F IBSTR="","Bill contains no diagnosis." S IBLN=$$SET(IBSTR,IBLN,1,80)
|
---|
| 32 | S IBI="",IBLN=1,IBCNT=0 F S IBI=$O(IBADX(IBI)) Q:'IBI D S IBLN=$$SET(IBSTR,IBLN,1,80)
|
---|
| 33 | . S IBCNT=IBCNT+1,IBX=$$ICD9^IBACSV(+IBADX(IBI),IBDATE)
|
---|
| 34 | . S IBSTR=$J("",5)_$J(IBCNT,3)_") "_$P(IBX,U,1)_$J("",(10-$L($P(IBX,U,1))))_$P(IBX,U,3)
|
---|
| 35 | ;
|
---|
| 36 | S VALMCNT=IBLN-1
|
---|
| 37 | Q
|
---|
| 38 | ;
|
---|
| 39 | SET(STR,LN,COL,WD,RV) ; set up TMP array with screen data
|
---|
| 40 | D SET^VALM10(LN,STR)
|
---|
| 41 | S LN=LN+1
|
---|
| 42 | Q LN
|
---|