- 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 Jan 18, 2025@03:28:53 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