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
|
---|