IBTRDD ;ALB/AAS - CLAIMS TRACKING, EXPANDED APPEALS - DENIALS ;02-JUL-1993
;;2.0;INTEGRATED BILLING;**458,461**;21-MAR-94;Build 58
;;Per VHA Directive 2004-038, this routine should not be modified.
;
% ;
EN ; -- main entry point for IBT EXPAND/EDIT DENIALS
I '$D(DT) D DT^DICRW
K XQORS,VALMEVL
I '$G(IBTRC) G EN^IBTRD
D EN^VALM("IBT EXPAND/EDIT DENIALS")
Q
;
HDR ; -- header code
D PID^VADPT N IBXR
S VALMHDR(1)="Expanded Appeal/Denial for: "_$$PT^IBTUTL1(DFN)
S IBXR=$$ROIEVT^IBTRR1(IBTRN) I IBXR'="" S VALMHDR(1)=VALMHDR(1)_$J(" ",(60-$L(VALMHDR(1))))_"ROI: "_IBXR
S VALMHDR(2)=" for: "_$$EXPAND^IBTRE(356,.18,$P(IBTRND,"^",18))_" on "_$$DAT1^IBOUTL($P(IBTRND,"^",6),2)
Q
;
INIT ; -- init variables and list array
N IBTRCD,IBTRCD1,IBTRN,IBTRND,DFN
K VALMQUIT
S VALMCNT=0,VALMBG=1
D BLD,HDR
Q
;
BLD ; -- build display
K ^TMP("IBTRDD",$J),^TMP("IBTRDDX",$J)
D KILL^VALM10()
S IBTRCD=$G(^IBT(356.2,+IBTRC,0)),IBTRCD1=$G(^(1))
S IBTRN=$P(IBTRCD,"^",2),DFN=$P(IBTRCD,"^",5)
S IBTRND=$G(^IBT(356,+IBTRN,0))
F I=1:1:30 D BLANK^IBTRED(.I)
S VALMCNT=30
S VAINDT=$P(IBTRND,U,6)
S VA200="" D INP^VADPT
D ACTION^IBTRCD,VISIT,CLIN,INS,USER,APADD,COMM,CONT
Q
;
COMM ; -- comment display
N OFFEST,START
S START=31,OFFSET=2
D COM1^IBTRCD0
Q
;
CONT ; -- contact info display
N OFFEST,START
S START=23,OFFSET=45
D CON1^IBTRCD0
Q
;
HIST ; --history display
N OFFEST,START
S START=31,OFFSET=2
;
Q
;
CLIN ; -- clinical data display
N OFFSET,START
S START=9,OFFSET=2
D CLIN1^IBTRED0
Q
;
APADD ; -- Appeals Address Display
N OFFSET,START
S START=9,OFFSET=45
D AP1^IBTRCD0
Q
;
USER ; -- User display
N OFFSET,START
S START=23,OFFSET=2
D USER1^IBTRCD0
Q
;
INS ; -- Ins. Co. Display
N OFFSET,START,IBCDFND,IBPHONE
S START=17,OFFSET=2
D ENINS^IBTRCD0
Q
;
VISIT ; -- Visit information
N OFFSET,START,VAIN,VAINDT,IBETYP
;S VAINDT=+IBTRCD+.24
;D INP^VADPT
S START=1,OFFSET=2
S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
D VISIT^IBTRED
I $D(VAIN(11)) D SET^IBCNSP(START+5,OFFSET," Attending: "_$P(VAIN(11),"^",2))
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K VALMQUIT,IBTRC,IBTRCD,IBTRCD1
K ^TMP("IBTRDD",$J),^TMP("IBTRDDX",$J)
D CLEAN^VALM10,FULL^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRDD 2370 printed Nov 22, 2024@17:37:45 Page 2
IBTRDD ;ALB/AAS - CLAIMS TRACKING, EXPANDED APPEALS - DENIALS ;02-JUL-1993
+1 ;;2.0;INTEGRATED BILLING;**458,461**;21-MAR-94;Build 58
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
% ;
EN ; -- main entry point for IBT EXPAND/EDIT DENIALS
+1 IF '$DATA(DT)
DO DT^DICRW
+2 KILL XQORS,VALMEVL
+3 IF '$GET(IBTRC)
GOTO EN^IBTRD
+4 DO EN^VALM("IBT EXPAND/EDIT DENIALS")
+5 QUIT
+6 ;
HDR ; -- header code
+1 DO PID^VADPT
NEW IBXR
+2 SET VALMHDR(1)="Expanded Appeal/Denial for: "_$$PT^IBTUTL1(DFN)
+3 SET IBXR=$$ROIEVT^IBTRR1(IBTRN)
IF IBXR'=""
SET VALMHDR(1)=VALMHDR(1)_$JUSTIFY(" ",(60-$LENGTH(VALMHDR(1))))_"ROI: "_IBXR
+4 SET VALMHDR(2)=" for: "_$$EXPAND^IBTRE(356,.18,$PIECE(IBTRND,"^",18))_" on "_$$DAT1^IBOUTL($PIECE(IBTRND,"^",6),2)
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 NEW IBTRCD,IBTRCD1,IBTRN,IBTRND,DFN
+2 KILL VALMQUIT
+3 SET VALMCNT=0
SET VALMBG=1
+4 DO BLD
DO HDR
+5 QUIT
+6 ;
BLD ; -- build display
+1 KILL ^TMP("IBTRDD",$JOB),^TMP("IBTRDDX",$JOB)
+2 DO KILL^VALM10()
+3 SET IBTRCD=$GET(^IBT(356.2,+IBTRC,0))
SET IBTRCD1=$GET(^(1))
+4 SET IBTRN=$PIECE(IBTRCD,"^",2)
SET DFN=$PIECE(IBTRCD,"^",5)
+5 SET IBTRND=$GET(^IBT(356,+IBTRN,0))
+6 FOR I=1:1:30
DO BLANK^IBTRED(.I)
+7 SET VALMCNT=30
+8 SET VAINDT=$PIECE(IBTRND,U,6)
+9 SET VA200=""
DO INP^VADPT
+10 DO ACTION^IBTRCD
DO VISIT
DO CLIN
DO INS
DO USER
DO APADD
DO COMM
DO CONT
+11 QUIT
+12 ;
COMM ; -- comment display
+1 NEW OFFEST,START
+2 SET START=31
SET OFFSET=2
+3 DO COM1^IBTRCD0
+4 QUIT
+5 ;
CONT ; -- contact info display
+1 NEW OFFEST,START
+2 SET START=23
SET OFFSET=45
+3 DO CON1^IBTRCD0
+4 QUIT
+5 ;
HIST ; --history display
+1 NEW OFFEST,START
+2 SET START=31
SET OFFSET=2
+3 ;
+4 QUIT
+5 ;
CLIN ; -- clinical data display
+1 NEW OFFSET,START
+2 SET START=9
SET OFFSET=2
+3 DO CLIN1^IBTRED0
+4 QUIT
+5 ;
APADD ; -- Appeals Address Display
+1 NEW OFFSET,START
+2 SET START=9
SET OFFSET=45
+3 DO AP1^IBTRCD0
+4 QUIT
+5 ;
USER ; -- User display
+1 NEW OFFSET,START
+2 SET START=23
SET OFFSET=2
+3 DO USER1^IBTRCD0
+4 QUIT
+5 ;
INS ; -- Ins. Co. Display
+1 NEW OFFSET,START,IBCDFND,IBPHONE
+2 SET START=17
SET OFFSET=2
+3 DO ENINS^IBTRCD0
+4 QUIT
+5 ;
VISIT ; -- Visit information
+1 NEW OFFSET,START,VAIN,VAINDT,IBETYP
+2 ;S VAINDT=+IBTRCD+.24
+3 ;D INP^VADPT
+4 SET START=1
SET OFFSET=2
+5 SET IBETYP=$GET(^IBE(356.6,+$PIECE(IBTRND,"^",18),0))
+6 DO VISIT^IBTRED
+7 IF $DATA(VAIN(11))
DO SET^IBCNSP(START+5,OFFSET," Attending: "_$PIECE(VAIN(11),"^",2))
+8 QUIT
+9 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL VALMQUIT,IBTRC,IBTRCD,IBTRCD1
+2 KILL ^TMP("IBTRDD",$JOB),^TMP("IBTRDDX",$JOB)
+3 DO CLEAN^VALM10
DO FULL^VALM1
+4 QUIT
