Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTRD1

IBTRD1.m

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