IBTRCD ;ALB/AAS - CLAIMS TRACKING - EXPAND CONTACTS SCREEN ; 02-JUL-1993
;;2.0;INTEGRATED BILLING;**210,458**;21-MAR-94;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
% ;
EN ; -- main entry point for IBT EXPAND/EDIT COMMUNICATIONS
I '$D(DT) D DT^DICRW
K XQORS,VALMEVL,IBTRC,IBTRD,IBTRV,IBTRN,DFN
I '$G(IBTRC) G EN^IBTRC
D EN^VALM("IBT EXPAND/EDIT COMMUNICATIONS")
Q
;
HDR ; -- header code
D PID^VADPT N IBXR
S VALMHDR(1)="Expanded Insurance Reviews 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),"2P")
Q
;
INIT ; -- init variables and list array
N IBTRCD,IBTRCD1
K VALMQUIT
S VALMCNT=0,VALMBG=1
D BLD,HDR
Q
;
BLD ; -- build display
K ^TMP("IBTRCD",$J),^TMP("IBTRCDDX",$J)
D KILL^VALM10()
S IBTRCD=$G(^IBT(356.2,IBTRC,0)),IBTRCD1=$G(^IBT(356.2,IBTRC,1))
S IBTRND=$G(^IBT(356,IBTRN,0))
F I=1:1:27 D BLANK^IBTRED(.I)
S VALMCNT=27
D ACTION,EN^IBTRCD0
Q
;
;
ACTION ; -- Ins. Action infomation display
N OFFSET,START,TCODE,IBACTION,IBLCNT
S START=1,OFFSET=45,IBLCNT=0
D SET^IBCNSP(START,OFFSET," Action Information ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET," Type Contact: "_$$EXPAND^IBTRE(356.2,.04,$P(IBTRCD,"^",4)))
S TCODE=$$TCODE^IBTRC(IBTRC) I TCODE D @TCODE
Q
10 ; -- pre-cert contact
15 ; -- admission review
20 ; -- urgent/emergent ins. contact
25 ; -- snf/nhcu review
30 ; -- continued stay contact
35 ; -- inpt retrospective review
S IBLCNT=2
D SET^IBCNSP(START+IBLCNT,OFFSET," Action: "_$$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)))
S IBACTION=$P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^",3)
S IBACTION=IBACTION+100 D @IBACTION
S IBLCNT=IBLCNT+1
Q
;
40 ; -- Discharge contact
100 ; -- No type of action
Q
50 ; -- outpatient treatment
55 ; -- opt retrospective review
S IBLCNT=2
D SET^IBCNSP(START+IBLCNT,OFFSET," Opt Treatment: "_$$EXPAND^IBTRE(356.2,.26,$P(IBTRCD,"^",26)))
S IBLCNT=IBLCNT+1
D SET^IBCNSP(START+IBLCNT,OFFSET," Action: "_$$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)))
S IBLCNT=IBLCNT+1
D SET^IBCNSP(START+IBLCNT,OFFSET," Auth. Number: "_$$AUTHN^IBTRC(IBTRC,18))
;D SET^IBCNSP(START+IBLCNT,OFFSET,"Treatment Auth: "_$$EXPAND^IBTRE(356.2,.27,$P(IBTRCD,"^",27)))
Q
60 ; -- Appeal
65 ; -- Nth appeal
D SET^IBCNSP(START+2,OFFSET," Appeal Type: "_$$EXPAND^IBTRE(356.2,.23,$P(IBTRCD,"^",23)))
D SET^IBCNSP(START+3,OFFSET," Case Status: "_$$EXPAND^IBTRE(356.2,.1,$P(IBTRCD,"^",10)))
D SET^IBCNSP(START+4,OFFSET,"No Days Pending: "_$$EXPAND^IBTRE(356.2,.25,$P(IBTRCD,"^",25)))
D SET^IBCNSP(START+5,OFFSET," Final Outcome: "_$$EXPAND^IBTRE(356.2,.29,$P(IBTRCD,"^",29)))
Q
70 ; -- Patient
80 ; -- Other
85 ; -- Insurance verification
Q
;
110 ; -- approval actions
S IBLCNT=IBLCNT+1
D SET^IBCNSP(START+IBLCNT,OFFSET,"Authorized From: "_$S($P(IBTRCD1,"^",8):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",12))))
S IBLCNT=IBLCNT+1
D SET^IBCNSP(START+IBLCNT,OFFSET," Authorized To: "_$S($P(IBTRCD1,"^",8):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",13))))
S IBLCNT=IBLCNT+1
D SET^IBCNSP(START+IBLCNT,OFFSET,"Authorized Diag: "_$$DIAG^IBTRE6($P(IBTRCD,"^",14),1,$$TRNDATE^IBACSV($G(IBTRN))))
S IBLCNT=IBLCNT+1
D SET^IBCNSP(START+IBLCNT,OFFSET," Auth. Number: "_$$AUTHN^IBTRC(IBTRC,18))
Q
120 ; -- denial actions
S IBLCNT=IBLCNT+1
D SET^IBCNSP(START+IBLCNT,OFFSET," Denied From: "_$S($P(IBTRCD1,"^",7):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",15))))
S IBLCNT=IBLCNT+1
D SET^IBCNSP(START+IBLCNT,OFFSET," Denied To: "_$S($P(IBTRCD1,"^",7):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",16))))
S IBI=0 F S IBI=$O(^IBT(356.2,IBTRC,12,IBI)) Q:'IBI!(IBLCNT>6) D
.S IBLCNT=IBLCNT+1
.D SET^IBCNSP(START+IBLCNT,OFFSET," Denial Reasons: "_$$EXPAND^IBTRE(356.212,.01,+$G(^IBT(356.2,IBTRC,12,IBI,0))))
Q
130 ; -- penalty
S IBI=0 F S IBI=$O(^IBT(356.2,IBTRC,13,IBI)) Q:'IBI!(IBLCNT>6) D
.S IBLCNT=IBLCNT+1
.D SET^IBCNSP(START+IBLCNT,OFFSET," Penalty: "_$$EXPAND^IBTRE(356.213,.01,+$G(^IBT(356.2,IBTRC,13,IBI,0))))
Q
140 ; -- case pending
S IBLCNT=IBLCNT+1
D SET^IBCNSP(START+IBLCNT,OFFSET," Case Pending: "_$$EXPAND^IBTRE(356.2,.2,$P(IBTRCD,"^",20)))
Q
150 ; -- no coverage
S IBLCNT=IBLCNT+1
D SET^IBCNSP(START+IBLCNT,OFFSET," No Coverage: "_$$EXPAND^IBTRE(356.2,.21,$P(IBTRCD,"^",21)))
Q
;
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K VALMQUIT,IBTRC,IBTRCD,IBTRCD1
K ^TMP("IBTRCD",$J),^TMP("IBTRCDDX",$J)
D CLEAN^VALM10,FULL^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRCD 4775 printed Oct 16, 2024@18:28:15 Page 2
IBTRCD ;ALB/AAS - CLAIMS TRACKING - EXPAND CONTACTS SCREEN ; 02-JUL-1993
+1 ;;2.0;INTEGRATED BILLING;**210,458**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
% ;
EN ; -- main entry point for IBT EXPAND/EDIT COMMUNICATIONS
+1 IF '$DATA(DT)
DO DT^DICRW
+2 KILL XQORS,VALMEVL,IBTRC,IBTRD,IBTRV,IBTRN,DFN
+3 IF '$GET(IBTRC)
GOTO EN^IBTRC
+4 DO EN^VALM("IBT EXPAND/EDIT COMMUNICATIONS")
+5 QUIT
+6 ;
HDR ; -- header code
+1 DO PID^VADPT
NEW IBXR
+2 SET VALMHDR(1)="Expanded Insurance Reviews 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),"2P")
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 NEW IBTRCD,IBTRCD1
+2 KILL VALMQUIT
+3 SET VALMCNT=0
SET VALMBG=1
+4 DO BLD
DO HDR
+5 QUIT
+6 ;
BLD ; -- build display
+1 KILL ^TMP("IBTRCD",$JOB),^TMP("IBTRCDDX",$JOB)
+2 DO KILL^VALM10()
+3 SET IBTRCD=$GET(^IBT(356.2,IBTRC,0))
SET IBTRCD1=$GET(^IBT(356.2,IBTRC,1))
+4 SET IBTRND=$GET(^IBT(356,IBTRN,0))
+5 FOR I=1:1:27
DO BLANK^IBTRED(.I)
+6 SET VALMCNT=27
+7 DO ACTION
DO EN^IBTRCD0
+8 QUIT
+9 ;
+10 ;
ACTION ; -- Ins. Action infomation display
+1 NEW OFFSET,START,TCODE,IBACTION,IBLCNT
+2 SET START=1
SET OFFSET=45
SET IBLCNT=0
+3 DO SET^IBCNSP(START,OFFSET," Action Information ",IORVON,IORVOFF)
+4 DO SET^IBCNSP(START+1,OFFSET," Type Contact: "_$$EXPAND^IBTRE(356.2,.04,$PIECE(IBTRCD,"^",4)))
+5 SET TCODE=$$TCODE^IBTRC(IBTRC)
IF TCODE
DO @TCODE
+6 QUIT
10 ; -- pre-cert contact
15 ; -- admission review
20 ; -- urgent/emergent ins. contact
25 ; -- snf/nhcu review
30 ; -- continued stay contact
35 ; -- inpt retrospective review
+1 SET IBLCNT=2
+2 DO SET^IBCNSP(START+IBLCNT,OFFSET," Action: "_$$EXPAND^IBTRE(356.2,.11,$PIECE(IBTRCD,"^",11)))
+3 SET IBACTION=$PIECE($GET(^IBE(356.7,+$PIECE(IBTRCD,"^",11),0)),"^",3)
+4 SET IBACTION=IBACTION+100
DO @IBACTION
+5 SET IBLCNT=IBLCNT+1
+6 QUIT
+7 ;
40 ; -- Discharge contact
100 ; -- No type of action
+1 QUIT
50 ; -- outpatient treatment
55 ; -- opt retrospective review
+1 SET IBLCNT=2
+2 DO SET^IBCNSP(START+IBLCNT,OFFSET," Opt Treatment: "_$$EXPAND^IBTRE(356.2,.26,$PIECE(IBTRCD,"^",26)))
+3 SET IBLCNT=IBLCNT+1
+4 DO SET^IBCNSP(START+IBLCNT,OFFSET," Action: "_$$EXPAND^IBTRE(356.2,.11,$PIECE(IBTRCD,"^",11)))
+5 SET IBLCNT=IBLCNT+1
+6 DO SET^IBCNSP(START+IBLCNT,OFFSET," Auth. Number: "_$$AUTHN^IBTRC(IBTRC,18))
+7 ;D SET^IBCNSP(START+IBLCNT,OFFSET,"Treatment Auth: "_$$EXPAND^IBTRE(356.2,.27,$P(IBTRCD,"^",27)))
+8 QUIT
60 ; -- Appeal
65 ; -- Nth appeal
+1 DO SET^IBCNSP(START+2,OFFSET," Appeal Type: "_$$EXPAND^IBTRE(356.2,.23,$PIECE(IBTRCD,"^",23)))
+2 DO SET^IBCNSP(START+3,OFFSET," Case Status: "_$$EXPAND^IBTRE(356.2,.1,$PIECE(IBTRCD,"^",10)))
+3 DO SET^IBCNSP(START+4,OFFSET,"No Days Pending: "_$$EXPAND^IBTRE(356.2,.25,$PIECE(IBTRCD,"^",25)))
+4 DO SET^IBCNSP(START+5,OFFSET," Final Outcome: "_$$EXPAND^IBTRE(356.2,.29,$PIECE(IBTRCD,"^",29)))
+5 QUIT
70 ; -- Patient
80 ; -- Other
85 ; -- Insurance verification
+1 QUIT
+2 ;
110 ; -- approval actions
+1 SET IBLCNT=IBLCNT+1
+2 DO SET^IBCNSP(START+IBLCNT,OFFSET,"Authorized From: "_$SELECT($PIECE(IBTRCD1,"^",8):"ENTIRE VISIT",1:$$DAT1^IBOUTL($PIECE(IBTRCD,"^",12))))
+3 SET IBLCNT=IBLCNT+1
+4 DO SET^IBCNSP(START+IBLCNT,OFFSET," Authorized To: "_$SELECT($PIECE(IBTRCD1,"^",8):"ENTIRE VISIT",1:$$DAT1^IBOUTL($PIECE(IBTRCD,"^",13))))
+5 SET IBLCNT=IBLCNT+1
+6 DO SET^IBCNSP(START+IBLCNT,OFFSET,"Authorized Diag: "_$$DIAG^IBTRE6($PIECE(IBTRCD,"^",14),1,$$TRNDATE^IBACSV($GET(IBTRN))))
+7 SET IBLCNT=IBLCNT+1
+8 DO SET^IBCNSP(START+IBLCNT,OFFSET," Auth. Number: "_$$AUTHN^IBTRC(IBTRC,18))
+9 QUIT
120 ; -- denial actions
+1 SET IBLCNT=IBLCNT+1
+2 DO SET^IBCNSP(START+IBLCNT,OFFSET," Denied From: "_$SELECT($PIECE(IBTRCD1,"^",7):"ENTIRE VISIT",1:$$DAT1^IBOUTL($PIECE(IBTRCD,"^",15))))
+3 SET IBLCNT=IBLCNT+1
+4 DO SET^IBCNSP(START+IBLCNT,OFFSET," Denied To: "_$SELECT($PIECE(IBTRCD1,"^",7):"ENTIRE VISIT",1:$$DAT1^IBOUTL($PIECE(IBTRCD,"^",16))))
+5 SET IBI=0
FOR
SET IBI=$ORDER(^IBT(356.2,IBTRC,12,IBI))
if 'IBI!(IBLCNT>6)
QUIT
Begin DoDot:1
+6 SET IBLCNT=IBLCNT+1
+7 DO SET^IBCNSP(START+IBLCNT,OFFSET," Denial Reasons: "_$$EXPAND^IBTRE(356.212,.01,+$GET(^IBT(356.2,IBTRC,12,IBI,0))))
End DoDot:1
+8 QUIT
130 ; -- penalty
+1 SET IBI=0
FOR
SET IBI=$ORDER(^IBT(356.2,IBTRC,13,IBI))
if 'IBI!(IBLCNT>6)
QUIT
Begin DoDot:1
+2 SET IBLCNT=IBLCNT+1
+3 DO SET^IBCNSP(START+IBLCNT,OFFSET," Penalty: "_$$EXPAND^IBTRE(356.213,.01,+$GET(^IBT(356.2,IBTRC,13,IBI,0))))
End DoDot:1
+4 QUIT
140 ; -- case pending
+1 SET IBLCNT=IBLCNT+1
+2 DO SET^IBCNSP(START+IBLCNT,OFFSET," Case Pending: "_$$EXPAND^IBTRE(356.2,.2,$PIECE(IBTRCD,"^",20)))
+3 QUIT
150 ; -- no coverage
+1 SET IBLCNT=IBLCNT+1
+2 DO SET^IBCNSP(START+IBLCNT,OFFSET," No Coverage: "_$$EXPAND^IBTRE(356.2,.21,$PIECE(IBTRCD,"^",21)))
+3 QUIT
+4 ;
+5 ;
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("IBTRCD",$JOB),^TMP("IBTRCDDX",$JOB)
+3 DO CLEAN^VALM10
DO FULL^VALM1
+4 QUIT
