IBTRD1 ;ALB/AAS - CLAIMS TRACKING - APPEAL/DENIAL ACTIONS ; 10-AUG-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% G EN^IBTRD
;
AA ; -- Add Appeal entry
N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,IBQUIT,IBTRCDT,IBXX,VALMY,IBTRN,IBTRC
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) D FULL^VALM1 S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX!$D(DIRUT) D
.S IBTRC=$P($G(^TMP("IBTRDDX",$J,+$O(^TMP("IBTRD",$J,"IDX",IBXX,0)))),"^",2)
.; -- must be a denial or a penalty
.S IBDENIAL=$O(^IBE(356.7,"ACODE",20,0))
.S IBPENAL=$O(^IBE(356.7,"ACODE",30,0))
.I '$D(^IBT(356.2,"ACT",IBDENIAL,IBTRC))&('$D(^IBT(356.2,"ACT",IBPENAL,IBTRC))) W !!,"You can only appeal a denial or an penalty." D PAUSE^VALM1 Q
.D AA1
D BLD^IBTRD
S VALMBCK="R"
Q
;
AA1 ; -- select date
N DIR,IBTRCDT
S DIR(0)="356.2,.01",DIR("A")="Select Appeal Date",DIR("B")="NOW"
D ^DIR K DIR
I $D(DIRUT)!($E(+Y,1,7)'?7N) G AA1Q
S IBTRCDT=+Y
;
; -- if not tracking id allow selecting
S IBTRDD=$G(^IBT(356.2,+IBTRC,0))
S IBTRN=$P(IBTRDD,"^",2)
S DFN=$P(IBTRDD,"^",5)
S IBPARNT=IBTRC
S IBCDFN=$P($G(^IBT(356.2,IBTRC,1)),"^",5)
;
; -- add entry
S IBTCOD=$S('$D(^IBT(356.2,"AP",IBTRC)):60,1:65)
D COM^IBTUTL3(IBTRCDT,$G(IBTRN),IBTCOD,$G(IBTRV))
; -- ibtrc now entry of new appeal
;
; -- edit based on
S DIE="^IBT(356.2,",DA=IBTRC
L +^IBT(356.2,+IBTRC):5 I '$T D LOCKED^IBTRCD1 G AA1Q
S DR="[IBT ADD APPEAL]"
;S DR=".18////"_IBPARNT_";1.05////"_IBCDFN_";.04;.23;.1;.25;11;.24;.19"
D ^DIE K DIE
L -^IBT(356.2,+IBTRC)
AA1Q Q
;
DT ; -- Delete Insurance Action entry
I '$D(^XUSEC("IB CLAIMS SUPERVISOR",DUZ)) D SORRY^IBTRE1 G DTQ
D EN^VALM2($G(XQORNOD(0)))
N I,J,IBXX,DIR,DIRUT,IBTRN
I $D(VALMY) D FULL^VALM1 S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX!$D(DIRUT) D
.S IBTRC=$P($G(^TMP("IBTRDDX",$J,+$O(^TMP("IBTRD",$J,"IDX",IBXX,0)))),"^",2),IBTRN=$P($G(^IBT(356.2,+IBTRC,0)),"^",2)
.I $O(^IBT(356.2,"AP",IBTRC,0)) W !,"Must first delete appeals associate* d with Denials" D PAUSE^VALM1 Q
.;
.W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure you want to delete entry #"_IBXX
.D ^DIR I Y'=1 W !,"Entry #",IBXX," not Deleted!" Q
.D DP1^IBTRC1
.Q
DTQ D BLD^IBTRD
S VALMBCK="R" Q
;
QE ; -- Quick edit Review entry
D EN^VALM2($G(XQORNOD(0)))
N I,J,IBXX,IBTRN,IBTRC
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBTRC=$P($G(^TMP("IBTRDDX",$J,+$O(^TMP("IBTRD",$J,"IDX",IBXX,0)))),"^",2),IBTRN=$P($G(^IBT(356.2,+IBTRC,0)),"^",2)
.D QE1
QEQ S VALMBCK="R"
D BLD^IBTRD
Q
;
QE1 N X,Y,DA,DR,DIC,DIE
D EDIT^IBTRCD1("[IBT QUICK EDIT]",1)
Q
;
NX(IBTMPNM) ; -- Go to next template
; -- Input template name
N I,J,IBXXC,VALMY,IBTRN
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXXC=0 F S IBXXC=$O(VALMY(IBXXC)) Q:'IBXXC D
.S IBTRC=$P($G(^TMP("IBTRDDX",$J,+$O(^TMP("IBTRD",$J,"IDX",IBXXC,0)))),"^",2),IBTRN=$P($G(^IBT(356.2,+IBTRC,0)),"^",2)
.S:'$D(DFN) DFN=$P($G(^IBT(356.2,+IBTRC,0)),"^",5)
.S:'$D(IBCNS) IBCNS=$P($G(^IBT(356.2,+IBTRC,0)),"^",8)
.D EN^VALM(IBTMPNM)
.K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
.K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
.D KVAR^VADPT
.Q
I '$D(IBFASTXT) D BLD^IBTRD
S VALMBCK="R"
Q
;
EDIT(IBTEMP) ; -- Edit entries
N VALMY
D EN^VALM2($G(XQORNOD(0)))
N I,J,IBXX
I $D(VALMY) D FULL^VALM1 S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBTRC=$P($G(^TMP("IBTRDDX",$J,+$O(^TMP("IBTRD",$J,"IDX",IBXX,0)))),"^",2)
.W !!,"Editing Entry #",IBXX,!
.D EDIT^IBTRCD1(IBTEMP,1)
S VALMBCK="R"
D BLD^IBTRD
Q
SHOWSC ; -- show sc conditions
N VALMY
D FULL^VALM1
I IBTRD["DPT",$D(DFN) D SHOWSC^IBTRC1 G SHOWQ
;
D EN^VALM2($G(XQORNOD(0)))
N I,J,IBXX,DFN,IBTRC
I $D(VALMY) D FULL^VALM1 S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBTRC=$P($G(^TMP("IBTRDDX",$J,+$O(^TMP("IBTRD",$J,"IDX",IBXX,0)))),"^",2)
.S DFN=$P($G(^IBT(356.2,+IBTRC,0)),"^",5)
.D SHOWSC^IBTRC1
SHOWQ S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRD1 4160 printed Apr 09, 2024@21:38:30 Page 2
IBTRD1 ;ALB/AAS - CLAIMS TRACKING - APPEAL/DENIAL ACTIONS ; 10-AUG-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% GOTO EN^IBTRD
+1 ;
AA ; -- Add Appeal entry
+1 NEW X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,IBQUIT,IBTRCDT,IBXX,VALMY,IBTRN,IBTRC
+2 DO EN^VALM2($GET(XQORNOD(0)))
+3 IF $DATA(VALMY)
DO FULL^VALM1
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX!$DATA(DIRUT)
QUIT
Begin DoDot:1
+4 SET IBTRC=$PIECE($GET(^TMP("IBTRDDX",$JOB,+$ORDER(^TMP("IBTRD",$JOB,"IDX",IBXX,0)))),"^",2)
+5 ; -- must be a denial or a penalty
+6 SET IBDENIAL=$ORDER(^IBE(356.7,"ACODE",20,0))
+7 SET IBPENAL=$ORDER(^IBE(356.7,"ACODE",30,0))
+8 IF '$DATA(^IBT(356.2,"ACT",IBDENIAL,IBTRC))&('$DATA(^IBT(356.2,"ACT",IBPENAL,IBTRC)))
WRITE !!,"You can only appeal a denial or an penalty."
DO PAUSE^VALM1
QUIT
+9 DO AA1
End DoDot:1
+10 DO BLD^IBTRD
+11 SET VALMBCK="R"
+12 QUIT
+13 ;
AA1 ; -- select date
+1 NEW DIR,IBTRCDT
+2 SET DIR(0)="356.2,.01"
SET DIR("A")="Select Appeal Date"
SET DIR("B")="NOW"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)!($EXTRACT(+Y,1,7)'?7N)
GOTO AA1Q
+5 SET IBTRCDT=+Y
+6 ;
+7 ; -- if not tracking id allow selecting
+8 SET IBTRDD=$GET(^IBT(356.2,+IBTRC,0))
+9 SET IBTRN=$PIECE(IBTRDD,"^",2)
+10 SET DFN=$PIECE(IBTRDD,"^",5)
+11 SET IBPARNT=IBTRC
+12 SET IBCDFN=$PIECE($GET(^IBT(356.2,IBTRC,1)),"^",5)
+13 ;
+14 ; -- add entry
+15 SET IBTCOD=$SELECT('$DATA(^IBT(356.2,"AP",IBTRC)):60,1:65)
+16 DO COM^IBTUTL3(IBTRCDT,$GET(IBTRN),IBTCOD,$GET(IBTRV))
+17 ; -- ibtrc now entry of new appeal
+18 ;
+19 ; -- edit based on
+20 SET DIE="^IBT(356.2,"
SET DA=IBTRC
+21 LOCK +^IBT(356.2,+IBTRC):5
IF '$TEST
DO LOCKED^IBTRCD1
GOTO AA1Q
+22 SET DR="[IBT ADD APPEAL]"
+23 ;S DR=".18////"_IBPARNT_";1.05////"_IBCDFN_";.04;.23;.1;.25;11;.24;.19"
+24 DO ^DIE
KILL DIE
+25 LOCK -^IBT(356.2,+IBTRC)
AA1Q QUIT
+1 ;
DT ; -- Delete Insurance Action entry
+1 IF '$DATA(^XUSEC("IB CLAIMS SUPERVISOR",DUZ))
DO SORRY^IBTRE1
GOTO DTQ
+2 DO EN^VALM2($GET(XQORNOD(0)))
+3 NEW I,J,IBXX,DIR,DIRUT,IBTRN
+4 IF $DATA(VALMY)
DO FULL^VALM1
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX!$DATA(DIRUT)
QUIT
Begin DoDot:1
+5 SET IBTRC=$PIECE($GET(^TMP("IBTRDDX",$JOB,+$ORDER(^TMP("IBTRD",$JOB,"IDX",IBXX,0)))),"^",2)
SET IBTRN=$PIECE($GET(^IBT(356.2,+IBTRC,0)),"^",2)
+6 IF $ORDER(^IBT(356.2,"AP",IBTRC,0))
WRITE !,"Must first delete appeals associate* d with Denials"
DO PAUSE^VALM1
QUIT
+7 ;
+8 WRITE !
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are You Sure you want to delete entry #"_IBXX
+9 DO ^DIR
IF Y'=1
WRITE !,"Entry #",IBXX," not Deleted!"
QUIT
+10 DO DP1^IBTRC1
+11 QUIT
End DoDot:1
DTQ DO BLD^IBTRD
+1 SET VALMBCK="R"
QUIT
+2 ;
QE ; -- Quick edit Review entry
+1 DO EN^VALM2($GET(XQORNOD(0)))
+2 NEW I,J,IBXX,IBTRN,IBTRC
+3 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+4 SET IBTRC=$PIECE($GET(^TMP("IBTRDDX",$JOB,+$ORDER(^TMP("IBTRD",$JOB,"IDX",IBXX,0)))),"^",2)
SET IBTRN=$PIECE($GET(^IBT(356.2,+IBTRC,0)),"^",2)
+5 DO QE1
End DoDot:1
QEQ SET VALMBCK="R"
+1 DO BLD^IBTRD
+2 QUIT
+3 ;
QE1 NEW X,Y,DA,DR,DIC,DIE
+1 DO EDIT^IBTRCD1("[IBT QUICK EDIT]",1)
+2 QUIT
+3 ;
NX(IBTMPNM) ; -- Go to next template
+1 ; -- Input template name
+2 NEW I,J,IBXXC,VALMY,IBTRN
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXXC=0
FOR
SET IBXXC=$ORDER(VALMY(IBXXC))
if 'IBXXC
QUIT
Begin DoDot:1
+5 SET IBTRC=$PIECE($GET(^TMP("IBTRDDX",$JOB,+$ORDER(^TMP("IBTRD",$JOB,"IDX",IBXXC,0)))),"^",2)
SET IBTRN=$PIECE($GET(^IBT(356.2,+IBTRC,0)),"^",2)
+6 if '$DATA(DFN)
SET DFN=$PIECE($GET(^IBT(356.2,+IBTRC,0)),"^",5)
+7 if '$DATA(IBCNS)
SET IBCNS=$PIECE($GET(^IBT(356.2,+IBTRC,0)),"^",8)
+8 DO EN^VALM(IBTMPNM)
+9 KILL IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
+10 KILL IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
+11 DO KVAR^VADPT
+12 QUIT
End DoDot:1
+13 IF '$DATA(IBFASTXT)
DO BLD^IBTRD
+14 SET VALMBCK="R"
+15 QUIT
+16 ;
EDIT(IBTEMP) ; -- Edit entries
+1 NEW VALMY
+2 DO EN^VALM2($GET(XQORNOD(0)))
+3 NEW I,J,IBXX
+4 IF $DATA(VALMY)
DO FULL^VALM1
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+5 SET IBTRC=$PIECE($GET(^TMP("IBTRDDX",$JOB,+$ORDER(^TMP("IBTRD",$JOB,"IDX",IBXX,0)))),"^",2)
+6 WRITE !!,"Editing Entry #",IBXX,!
+7 DO EDIT^IBTRCD1(IBTEMP,1)
End DoDot:1
+8 SET VALMBCK="R"
+9 DO BLD^IBTRD
+10 QUIT
SHOWSC ; -- show sc conditions
+1 NEW VALMY
+2 DO FULL^VALM1
+3 IF IBTRD["DPT"
IF $DATA(DFN)
DO SHOWSC^IBTRC1
GOTO SHOWQ
+4 ;
+5 DO EN^VALM2($GET(XQORNOD(0)))
+6 NEW I,J,IBXX,DFN,IBTRC
+7 IF $DATA(VALMY)
DO FULL^VALM1
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+8 SET IBTRC=$PIECE($GET(^TMP("IBTRDDX",$JOB,+$ORDER(^TMP("IBTRD",$JOB,"IDX",IBXX,0)))),"^",2)
+9 SET DFN=$PIECE($GET(^IBT(356.2,+IBTRC,0)),"^",5)
+10 DO SHOWSC^IBTRC1
End DoDot:1
SHOWQ SET VALMBCK="R"
+1 QUIT
