| [613] | 1 | IBJTBC ;ALB/ARH - TPI BILL PROCEDURES SCREEN ;02-MAR-1995
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**39,80,51,137,210,349**;21-MAR-94;Build 46
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; -- main entry point for IBJ TP BILL PROCEDURES
|
|---|
| 6 | D EN^VALM("IBJT BILL PROCEDURES")
|
|---|
| 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("IBJTBC",$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("IBJTBC",$J)
|
|---|
| 25 | D CLEAR^VALM1
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | BLD ;
|
|---|
| 29 | N IB,IBI,IBJ,IBX,IBY,IBDXI,IBLN,IBSTR,IBD,IBT,IBPRC,IBXDATA,IBZPRC,IBZDX
|
|---|
| 30 | D F^IBCEF("N-UB-04 PROCEDURES","IBZPRC",,IBIFN)
|
|---|
| 31 | S IBSTR=""
|
|---|
| 32 | I +$O(IBZPRC(0))=0 S IBLN=1 F IBSTR="","Bill contains no procedures." S IBLN=$$SET(IBSTR,IBLN)
|
|---|
| 33 | ;
|
|---|
| 34 | D F^IBCEF("N-DIAGNOSES","IBZDX",,IBIFN)
|
|---|
| 35 | S IBX=0,IBI="" F S IBI=$O(IBZDX(IBI)) Q:'IBI S IBDXI($P(IBZDX(IBI),U,2))=IBI
|
|---|
| 36 | S IBLN=1,IBI="" F S IBI=$O(IBZPRC(IBI)) Q:'IBI D S IBLN=$$SET(IBSTR,IBLN)
|
|---|
| 37 | . N IBDATE ; Date of procedure
|
|---|
| 38 | . S IBX=IBZPRC(IBI)
|
|---|
| 39 | . S IBDATE=$P(IBX,U,2) I 'IBDATE S IBDATE=$$BDATE^IBACSV(IBIFN) ; The bills date
|
|---|
| 40 | . S IBPRC=$$PRCD^IBCEF1($P(IBX,U),1,IBDATE) Q:IBPRC=""
|
|---|
| 41 | . S IBT=0,IBSTR=" "_$P(IBPRC,U,2)
|
|---|
| 42 | . I +$P(IBZPRC(IBI),U,15) S IBSTR=IBSTR_" "_$$MODLST^IBEFUNC2($P(IBZPRC(IBI),U,15))
|
|---|
| 43 | . S IBT=20,IBD=$P(IBPRC,U,3) S IBSTR=$$SETLN(IBD,IBSTR,IBT,20)
|
|---|
| 44 | . S IBT=41,IBD=$$DATE^IBJU1(+$P(IBX,U,2)) S IBSTR=$$SETLN(IBD,IBSTR,IBT,8)
|
|---|
| 45 | . S IBT=51,IBY=$P(IBX,U,5) I IBY'="" S IBD="BASC: Yes" D
|
|---|
| 46 | .. S IBSTR=$$SETLN(IBD,IBSTR,IBT,29),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
|
|---|
| 47 | . S IBY=$P(IBX,U,6) I IBY'="" S IBD="DIV: "_$P($G(^DG(40.8,+IBY,0)),U,1) D
|
|---|
| 48 | .. S IBSTR=$$SETLN(IBD,IBSTR,IBT,29),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
|
|---|
| 49 | . S IBY=$P(IBX,U,7) I IBY'="" S IBD="CLINIC: "_$P($G(^SC(+IBY,0)),U,1) D
|
|---|
| 50 | .. S IBSTR=$$SETLN(IBD,IBSTR,IBT,29),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
|
|---|
| 51 | . S IBY=$P(IBX,U,9) I IBY'="" D
|
|---|
| 52 | .. S IBT=51,IBY=$G(^IBE(353.1,+IBY,0)),IBD="POS: "_$P(IBY,U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
|
|---|
| 53 | .. S IBT=63,IBD=$P(IBY,U,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,12),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
|
|---|
| 54 | . S IBY=$P(IBX,U,10) I IBY'="" D
|
|---|
| 55 | .. S IBT=51,IBY=$G(^IBE(353.2,+IBY,0)),IBD="TOS: "_$P(IBY,U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
|
|---|
| 56 | .. S IBT=63,IBD=$P(IBY,U,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,17),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
|
|---|
| 57 | . S IBT=51,IBD=$P(IBX,U,16) I IBD,$P(IBX,U,10)=7 S IBSTR=$$SETLN("MINUTES: "_$P(IBX,U,16),IBSTR,IBT,15)
|
|---|
| 58 | . ;
|
|---|
| 59 | . S IBT=51 F IBJ=11:1:14 S IBY=$P(IBX,U,IBJ) I IBY'="" D S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
|
|---|
| 60 | .. S IBY=$G(IBDXI(+IBY)) Q:'IBY S IBD="DX ("_IBY_"): "
|
|---|
| 61 | .. S IBY=+$G(IBZDX(+IBY)) Q:'IBY S IBY=$$ICD9^IBACSV(+IBY,IBDATE)
|
|---|
| 62 | .. S IBT=51,IBD=IBD_$P(IBY,U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBT,15)
|
|---|
| 63 | .. S IBT=67,IBD=$P(IBY,U,3) S IBSTR=$$SETLN(IBD,IBSTR,IBT,13)
|
|---|
| 64 | ;
|
|---|
| 65 | S VALMCNT=IBLN-1
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | SETLN(STR,IBX,COL,WD) ;
|
|---|
| 69 | S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
|
|---|
| 70 | Q IBX
|
|---|
| 71 | ;
|
|---|
| 72 | SET(STR,LN) ; set up TMP array with screen data
|
|---|
| 73 | N IBX,IBI
|
|---|
| 74 | D SET^VALM10(LN,STR)
|
|---|
| 75 | S LN=LN+1
|
|---|
| 76 | SETQ Q LN
|
|---|
