| 1 | IBTRVD ;ALB/AAS - CLAIMS TRACKING - EXPANDED REVIEW SCREEN;02-JUL-1993
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**266**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | % ;
|
|---|
| 5 | EN ; -- main entry point for IBT EXPAND/EDIT REVIEW from menus
|
|---|
| 6 | K XQORS,VALMEVL,IBTRV,IBTRN,DFN,IBTRC,IBTRD
|
|---|
| 7 | I '$D(IBTRV) G ^IBTRV
|
|---|
| 8 | D EN^VALM("IBT EXPAND/EDIT REVIEW")
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | HDR ; -- header code
|
|---|
| 12 | D PID^VADPT
|
|---|
| 13 | S VALMHDR(1)="Expanded Review for: "_$$PT^IBTUTL1(DFN)_" ROI:"_$$EXPAND^IBTRE(356,.31,$P(^IBT(356,IBTRN,0),"^",31))
|
|---|
| 14 | S VALMHDR(2)=" for: "_$P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^")_" on "_$$DAT1^IBOUTL(+IBTRVD)
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | INIT ; -- init variables and list array
|
|---|
| 18 | N IBTRND,IBTRVD,IBTRVD1,IBTRTP,VAIN,VAINDT
|
|---|
| 19 | K VALMQUIT
|
|---|
| 20 | S VALMCNT=0,VALMBG=1
|
|---|
| 21 | D BLD,HDR
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | BLD ; -- build dispaly
|
|---|
| 25 | K ^TMP("IBTRVD",$J),^TMP("IBTRVDDX",$J)
|
|---|
| 26 | S IBTRND=$G(^IBT(356,IBTRN,0))
|
|---|
| 27 | S IBTRVD=$G(^IBT(356.1,+IBTRV,0))
|
|---|
| 28 | S IBTRVD1=$G(^IBT(356.1,+IBTRV,1))
|
|---|
| 29 | S IBTRTP=$$TRTP^IBTRV(IBTRV)
|
|---|
| 30 | F I=1:1:28 D BLANK^IBTRED(.I)
|
|---|
| 31 | D KILL^VALM10()
|
|---|
| 32 | S VALMCNT=28
|
|---|
| 33 | D ^IBTRVD0,COMMENT,CLIN
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | ;
|
|---|
| 37 | CLIN ; -- Clinical info plus DRG/los information
|
|---|
| 38 | N OFFSET,START,DGPM,IBDT,IBDR
|
|---|
| 39 | S START=17,OFFSET=45
|
|---|
| 40 | ;D SET^IBCNSP(START,OFFSET," Clinical Information ",IORVON,IORVOFF)
|
|---|
| 41 | D CLIN1^IBTRED0
|
|---|
| 42 | Q:$$TRTP^IBTRE1(IBTRN)>1
|
|---|
| 43 | S DGPM=+$P(^IBT(356,IBTRN,0),"^",5)
|
|---|
| 44 | S IBDT=0 F S IBDT=$O(^IBT(356.93,"AMVD",+DGPM,IBDT)) Q:'IBDT S IBDR=$O(^IBT(356.93,"AMVD",+DGPM,IBDT,0))
|
|---|
| 45 | S IBDR=$G(^IBT(356.93,+$G(IBDR),0))
|
|---|
| 46 | D SET^IBCNSP(START+6,OFFSET," Interim DRG: "_$S(+IBDR:+IBDR_" - "_$$DRGTD^IBACSV(+IBDR,$P(IBDR,"^",3))_" on "_$$DAT1^IBOUTL($P(IBDR,"^",3)),1:""))
|
|---|
| 47 | D SET^IBCNSP(START+7,OFFSET," Estimate ALOS: "_$S(+IBDR:$J($P(IBDR,"^",4),6,1),1:""))
|
|---|
| 48 | D SET^IBCNSP(START+8,OFFSET,"Days Remaining: "_$S(+IBDR:$J($P(IBDR,"^",5),6),1:""))
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | COMMENT ; -- Display Comment
|
|---|
| 52 | N OFFSET,START,I,IBLCNT
|
|---|
| 53 | S START=27,OFFSET=2
|
|---|
| 54 | D SET^IBCNSP(START,OFFSET," Review Comments ",IORVON,IORVOFF)
|
|---|
| 55 | S (IBLCNT,IBI)=0 F S IBI=$O(^IBT(356.1,IBTRV,11,IBI)) Q:IBI<1 D
|
|---|
| 56 | .S IBLCNT=IBLCNT+1
|
|---|
| 57 | .D SET^IBCNSP(START+IBLCNT,OFFSET," "_$E($G(^IBT(356.1,IBTRV,11,IBI,0)),1,80))
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | HELP ; -- help code
|
|---|
| 61 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | EXIT ; -- exit code
|
|---|
| 65 | K VALMQUIT,IBTRV
|
|---|
| 66 | D CLEAN^VALM10,FULL^VALM1
|
|---|
| 67 | Q
|
|---|
