IBTRVD.m

IBTRVD	;ALB/AAS - CLAIMS TRACKING - EXPANDED REVIEW SCREEN ; 02-JUL-1993

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

%	;

EN	; -- main entry point for IBT EXPAND/EDIT REVIEW from menus

	K XQORS,VALMEVL,IBTRV,IBTRN,DFN,IBTRC,IBTRD

	I '$D(IBTRV) G ^IBTRV

	D EN^VALM("IBT EXPAND/EDIT REVIEW")

	Q

	;

HDR	; -- header code

	D PID^VADPT

	S VALMHDR(1)="Expanded Review for: "_$$PT^IBTUTL1(DFN)_"   ROI:"_$$EXPAND^IBTRE(356,.31,$P(^IBT(356,IBTRN,0),"^",31))

	S VALMHDR(2)="                for: "_$P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^")_" on "_$$DAT1^IBOUTL(+IBTRVD)

	Q

	;

INIT	; -- init variables and list array

	N IBTRND,IBTRVD,IBTRVD1,IBTRTP,VAIN,VAINDT

	K VALMQUIT

	S VALMCNT=0,VALMBG=1

	D BLD,HDR

	Q

	;

BLD	; -- build dispaly

	K ^TMP("IBTRVD",$J),^TMP("IBTRVDDX",$J)

	S IBTRND=$G(^IBT(356,IBTRN,0))

	S IBTRVD=$G(^IBT(356.1,+IBTRV,0))

	S IBTRVD1=$G(^IBT(356.1,+IBTRV,1))

	S IBTRTP=$$TRTP^IBTRV(IBTRV)

	F I=1:1:28 D BLANK^IBTRED(.I)

	D KILL^VALM10()

	S VALMCNT=28

	D ^IBTRVD0,COMMENT,CLIN

	Q

	;

	;

CLIN	; -- Clinical info plus DRG/los information

	N OFFSET,START,DGPM,IBDT,IBDR

	S START=17,OFFSET=45

	;D SET^IBCNSP(START,OFFSET," Clinical Information ",IORVON,IORVOFF)

	D CLIN1^IBTRED0

	Q:$$TRTP^IBTRE1(IBTRN)>1

	S DGPM=+$P(^IBT(356,IBTRN,0),"^",5)

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

	S IBDR=$G(^IBT(356.93,+$G(IBDR),0))

	D SET^IBCNSP(START+6,OFFSET,"   Interim DRG: "_$S(+IBDR:+IBDR_" - "_$G(^ICD(+IBDR,1,1,0))_" on "_$$DAT1^IBOUTL($P(IBDR,"^",3)),1:""))

	D SET^IBCNSP(START+7,OFFSET," Estimate ALOS: "_$S(+IBDR:$J($P(IBDR,"^",4),6,1),1:""))

	D SET^IBCNSP(START+8,OFFSET,"Days Remaining: "_$S(+IBDR:$J($P(IBDR,"^",5),6),1:""))

	Q

	;

COMMENT	; -- Display Comment

	N OFFSET,START,I,IBLCNT

	S START=27,OFFSET=2

	D SET^IBCNSP(START,OFFSET," Review Comments ",IORVON,IORVOFF)

	S (IBLCNT,IBI)=0 F  S IBI=$O(^IBT(356.1,IBTRV,11,IBI)) Q:IBI<1  D

	.S IBLCNT=IBLCNT+1

	.D SET^IBCNSP(START+IBLCNT,OFFSET,"  "_$E($G(^IBT(356.1,IBTRV,11,IBI,0)),1,80))

	Q

	;

HELP	; -- help code

	S X="?" D DISP^XQORM1 W !!

	Q

	;

EXIT	; -- exit code

	K VALMQUIT,IBTRV

	D CLEAN^VALM10,FULL^VALM1

	Q

IBTRVD    ;ALB/AAS - CLAIMS TRACKING - EXPANDED REVIEW SCREEN ; 02-JUL-1993

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

%         ;

EN        ; -- main entry point for IBT EXPAND/EDIT REVIEW from menus

 +1        KILL XQORS,VALMEVL,IBTRV,IBTRN,DFN,IBTRC,IBTRD

 +2        IF '$DATA(IBTRV)

               GOTO ^IBTRV

 +3        DO EN^VALM("IBT EXPAND/EDIT REVIEW")

 +4        QUIT 

 +5       ;

HDR       ; -- header code

 +1        DO PID^VADPT

 +2        SET VALMHDR(1)="Expanded Review for: "_$$PT^IBTUTL1(DFN)_"   ROI:"_$$EXPAND^IBTRE(356,.31,$PIECE(^IBT(356,IBTRN,0),"^",31))

 +3        SET VALMHDR(2)="                for: "_$PIECE($GET(^IBE(356.11,+$PIECE(IBTRVD,"^",22),0)),"^")_" on "_$$DAT1^IBOUTL(+IBTRVD)

 +4        QUIT 

 +5       ;

INIT      ; -- init variables and list array

 +1        NEW IBTRND,IBTRVD,IBTRVD1,IBTRTP,VAIN,VAINDT

 +2        KILL VALMQUIT

 +3        SET VALMCNT=0

           SET VALMBG=1

 +4        DO BLD

           DO HDR

 +5        QUIT 

 +6       ;

BLD       ; -- build dispaly

 +1        KILL ^TMP("IBTRVD",$JOB),^TMP("IBTRVDDX",$JOB)

 +2        SET IBTRND=$GET(^IBT(356,IBTRN,0))

 +3        SET IBTRVD=$GET(^IBT(356.1,+IBTRV,0))

 +4        SET IBTRVD1=$GET(^IBT(356.1,+IBTRV,1))

 +5        SET IBTRTP=$$TRTP^IBTRV(IBTRV)

 +6        FOR I=1:1:28

               DO BLANK^IBTRED(.I)

 +7        DO KILL^VALM10()

 +8        SET VALMCNT=28

 +9        DO ^IBTRVD0

           DO COMMENT

           DO CLIN

 +10       QUIT 

 +11      ;

 +12      ;

CLIN      ; -- Clinical info plus DRG/los information

 +1        NEW OFFSET,START,DGPM,IBDT,IBDR

 +2        SET START=17

           SET OFFSET=45

 +3       ;D SET^IBCNSP(START,OFFSET," Clinical Information ",IORVON,IORVOFF)

 +4        DO CLIN1^IBTRED0

 +5        IF $$TRTP^IBTRE1(IBTRN)>1

               QUIT 

 +6        SET DGPM=+$PIECE(^IBT(356,IBTRN,0),"^",5)

 +7        SET IBDT=0

           FOR 

               SET IBDT=$ORDER(^IBT(356.93,"AMVD",+DGPM,IBDT))

               IF 'IBDT

                   QUIT 

               SET IBDR=$ORDER(^IBT(356.93,"AMVD",+DGPM,IBDT,0))

 +8        SET IBDR=$GET(^IBT(356.93,+$GET(IBDR),0))

 +9        DO SET^IBCNSP(START+6,OFFSET,"   Interim DRG: "_$SELECT(+IBDR:+IBDR_" - "_$GET(^ICD(+IBDR,1,1,0))_" on "_$$DAT1^IBOUTL($PIECE(IBDR,"^",3)),1:""))

 +10       DO SET^IBCNSP(START+7,OFFSET," Estimate ALOS: "_$SELECT(+IBDR:$JUSTIFY($PIECE(IBDR,"^",4),6,1),1:""))

 +11       DO SET^IBCNSP(START+8,OFFSET,"Days Remaining: "_$SELECT(+IBDR:$JUSTIFY($PIECE(IBDR,"^",5),6),1:""))

 +12       QUIT 

 +13      ;

COMMENT   ; -- Display Comment

 +1        NEW OFFSET,START,I,IBLCNT

 +2        SET START=27

           SET OFFSET=2

 +3        DO SET^IBCNSP(START,OFFSET," Review Comments ",IORVON,IORVOFF)

 +4        SET (IBLCNT,IBI)=0

           FOR 

               SET IBI=$ORDER(^IBT(356.1,IBTRV,11,IBI))

               IF IBI<1

                   QUIT 

               Begin DoDot:1

 +5                SET IBLCNT=IBLCNT+1

 +6                DO SET^IBCNSP(START+IBLCNT,OFFSET,"  "_$EXTRACT($GET(^IBT(356.1,IBTRV,11,IBI,0)),1,80))

               End DoDot:1

 +7        QUIT 

 +8       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL VALMQUIT,IBTRV

 +2        DO CLEAN^VALM10

           DO FULL^VALM1

 +3        QUIT