IBTRC1 ;ALB/AAS - CLAIMS TRACKING - INSURANCE ACTIONS ACTIONS ; 14-JUL-93
;;2.0;INTEGRATED BILLING;**458**;21-MAR-94;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
% G EN^IBTRC
;
AI ; -- Add ins. Action entry
N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,IBQUIT,IBTRCDT,DIR,DIRUT,DUOUT
;
; -- select date
S DIR(0)="356.2,.01",DIR("A")="Select Insurance Review or Contact Date",DIR("B")="NOW"
D ^DIR K DIR
I $D(DIRUT)!($D(DUOUT))!(+Y<1) G AIQ
S IBTRCDT=+Y
;
; -- if not tracking id allow selecting
I '$G(IBTRN) D
.S DIC="^IBT(356,",DIC(0)="AEQ",D="ADFN"_DFN
.D IX^DIC K DIC
.I +Y>1 S IBTRN=+Y
;
; -- add entry
D COM^IBTUTL3(IBTRCDT,$G(IBTRN),"",$G(IBTRV))
;
; -- edit based on type/action
D QE1
D BLD^IBTRC
S VALMBCK="R"
AIQ Q
;
DT ; -- Delete Insurance Action entry
I '$D(^XUSEC("IB CLAIMS SUPERVISOR",DUZ)) D SORRY^IBTRE1 G DTQ
N I,J,IBXX,DIR,DIRUT,VALMY
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("IBTRCDX",$J,+$O(^TMP("IBTRC",$J,"IDX",IBXX,0)))),"^",2)
.I $O(^IBT(356.2,"AP",IBTRC,0)) W !,"Must first delete appeals associated 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
.Q
DTQ D BLD^IBTRC
S VALMBCK="R" Q
;
DP1 ; -- actual deletion
N DA,DIC,DIK
;
; -- delete reviews, communications,
S DA=IBTRC,DIK="^IBT(356.2," D ^DIK
W !,"Entry ",IBXX," Deleted!"
Q
;
QE ; -- Quick edit Review entry
N I,J,IBXX,VALMY
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBTRC=$P($G(^TMP("IBTRCDX",$J,+$O(^TMP("IBTRC",$J,"IDX",IBXX,0)))),"^",2)
.D QE1
QEQ S VALMBCK="R"
D BLD^IBTRC
Q
;
QE1 N X,Y,DA,DR,DIC,DIE,IBSEL,IBTLST
D EDIT^IBTRCD1("[IBT QUICK EDIT]",1)
Q
I $$TRTP^IBTRE1(IBTRN)<3 D ;clinical info only on inpt/outpt
.; -- diagnosis edit
.D EN^IBTRE3(IBTRN) Q:$G(IBSEL)["^"
.;
.; -- procedure edit / only inpt. / outpt use add/edit
.I $$TRTP^IBTRE1(IBTRN)<2 D EN^IBTRE4(IBTRN) Q:$G(IBSEL)["^"
.;
.; -- provider edit
.D EN^IBTRE5(IBTRN)
Q
;
NX(IBTMPNM) ; -- Go to next template
; -- Input template name
N I,J,IBXXC,VALMY
S IBTSAV("IBTRN")=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("IBTRCDX",$J,+$O(^TMP("IBTRC",$J,"IDX",IBXXC,0)))),"^",2)
.D EN^VALM(IBTMPNM)
.K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,VAUTD
.K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
.D KVAR^VADPT
.Q
S IBTRN=$G(IBTSAV("IBTRN"))
I '$D(IBFASTXT) D BLD^IBTRC
S VALMBCK="R"
Q
;
EDIT(IBTEMP) ; -- Edit entries
N I,J,IBXX,VALMY
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) D FULL^VALM1 S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBTRC=$P($G(^TMP("IBTRCDX",$J,+$O(^TMP("IBTRC",$J,"IDX",IBXX,0)))),"^",2)
.W !!,"Editing Entry #",IBXX,!
.D EDIT^IBTRCD1(IBTEMP,1)
S VALMBCK="R"
D BLD^IBTRC
Q
;
PRECRT(IBTRN,LNG) ; -- find precert number for a tracking entry
; -- input ibtrn = internal entry of tracking id.
;
S PRECERT=""
I '$G(IBTRN) G PRECQ
S PRECERT=$O(^IBT(356.2,"APRE",IBTRN,0))
I +$G(LNG),$L(PRECERT)>LNG S PRECERT=$E(PRECERT,1,(LNG-1))_"*"
PRECQ Q PRECERT
;
SHOWSC ; -- display sc conditions
N VAEL,TAB,IBTRCSC
D FULL^VALM1
D ELIG^VADPT
W !!,"Patient: ",$$PT^IBTUTL1(DFN)
I 'VAEL(3) W !,"Patient Not Service Connected",!! G SHOWQ
W !,?5,"Service Connected Percent: "_+$P(VAEL(3),"^",2)_"%"
S TAB=5,IBTRCSC=1 D SC^IBTOAT2
SHOWQ D PAUSE^VALM1
S VALMBCK="R"
Q
;
CP ; -- change patient from within insurance reviews
N VALMQUIT,IBDFN,IBTRNOLD,IBY
D FULL^VALM1
S IBDFN=DFN D PAT^IBCNSM
I $D(VALMQUIT) S DFN=IBDFN
S IBTRNOLD=IBTRN K IBTRN
D TRAC^IBTRV
I '$G(IBTRN) S DFN=IBDFN,IBTRN=IBTRNOLD
S IBTRND=$G(^IBT(356,+IBTRN,0))
D BLD^IBTRC,HDR^IBTRC
S VALMBCK="R"
CPQ Q
;
SCREEN(ACODE,CTYPE) ; -- screen for action field of file 356.2
; -- called by input transform
; input ACODE = piece 3 (action code) of entry being screen in 356.7
; CTYPE = type of review, pointer to 356.11
;
S CTYPE=$P($G(^IBE(356.11,+CTYPE,0)),"^",2) I 'CTYPE Q 1
Q $S(CTYPE=10:1,CTYPE=20:1,CTYPE=25:1,CTYPE=30:1,CTYPE=35:1,CTYPE=50&(ACODE<30):1,CTYPE=55&(ACODE<30):1,1:0)
;Q $S(CTYPE=10:1,CTYPE=20:1,CTYPE=30:1,CTYPE=50&(ACODE<30):1,1:0)
;Q $S(CTYPE=1:1,CTYPE=2&(ACODE'=30):1,CTYPE=3:1,CTYPE=5&(ACODE<30):1,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRC1 4700 printed Dec 13, 2024@02:27:34 Page 2
IBTRC1 ;ALB/AAS - CLAIMS TRACKING - INSURANCE ACTIONS ACTIONS ; 14-JUL-93
+1 ;;2.0;INTEGRATED BILLING;**458**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
% GOTO EN^IBTRC
+1 ;
AI ; -- Add ins. Action entry
+1 NEW X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,IBQUIT,IBTRCDT,DIR,DIRUT,DUOUT
+2 ;
+3 ; -- select date
+4 SET DIR(0)="356.2,.01"
SET DIR("A")="Select Insurance Review or Contact Date"
SET DIR("B")="NOW"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)!($DATA(DUOUT))!(+Y<1)
GOTO AIQ
+7 SET IBTRCDT=+Y
+8 ;
+9 ; -- if not tracking id allow selecting
+10 IF '$GET(IBTRN)
Begin DoDot:1
+11 SET DIC="^IBT(356,"
SET DIC(0)="AEQ"
SET D="ADFN"_DFN
+12 DO IX^DIC
KILL DIC
+13 IF +Y>1
SET IBTRN=+Y
End DoDot:1
+14 ;
+15 ; -- add entry
+16 DO COM^IBTUTL3(IBTRCDT,$GET(IBTRN),"",$GET(IBTRV))
+17 ;
+18 ; -- edit based on type/action
+19 DO QE1
+20 DO BLD^IBTRC
+21 SET VALMBCK="R"
AIQ QUIT
+1 ;
DT ; -- Delete Insurance Action entry
+1 IF '$DATA(^XUSEC("IB CLAIMS SUPERVISOR",DUZ))
DO SORRY^IBTRE1
GOTO DTQ
+2 NEW I,J,IBXX,DIR,DIRUT,VALMY
+3 DO EN^VALM2($GET(XQORNOD(0)))
+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("IBTRCDX",$JOB,+$ORDER(^TMP("IBTRC",$JOB,"IDX",IBXX,0)))),"^",2)
+6 IF $ORDER(^IBT(356.2,"AP",IBTRC,0))
WRITE !,"Must first delete appeals associated 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
+11 QUIT
End DoDot:1
DTQ DO BLD^IBTRC
+1 SET VALMBCK="R"
QUIT
+2 ;
DP1 ; -- actual deletion
+1 NEW DA,DIC,DIK
+2 ;
+3 ; -- delete reviews, communications,
+4 SET DA=IBTRC
SET DIK="^IBT(356.2,"
DO ^DIK
+5 WRITE !,"Entry ",IBXX," Deleted!"
+6 QUIT
+7 ;
QE ; -- Quick edit Review entry
+1 NEW I,J,IBXX,VALMY
+2 DO EN^VALM2($GET(XQORNOD(0)))
+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("IBTRCDX",$JOB,+$ORDER(^TMP("IBTRC",$JOB,"IDX",IBXX,0)))),"^",2)
+5 DO QE1
End DoDot:1
QEQ SET VALMBCK="R"
+1 DO BLD^IBTRC
+2 QUIT
+3 ;
QE1 NEW X,Y,DA,DR,DIC,DIE,IBSEL,IBTLST
+1 DO EDIT^IBTRCD1("[IBT QUICK EDIT]",1)
+2 QUIT
+3 ;clinical info only on inpt/outpt
IF $$TRTP^IBTRE1(IBTRN)<3
Begin DoDot:1
+4 ; -- diagnosis edit
+5 DO EN^IBTRE3(IBTRN)
if $GET(IBSEL)["^"
QUIT
+6 ;
+7 ; -- procedure edit / only inpt. / outpt use add/edit
+8 IF $$TRTP^IBTRE1(IBTRN)<2
DO EN^IBTRE4(IBTRN)
if $GET(IBSEL)["^"
QUIT
+9 ;
+10 ; -- provider edit
+11 DO EN^IBTRE5(IBTRN)
End DoDot:1
+12 QUIT
+13 ;
NX(IBTMPNM) ; -- Go to next template
+1 ; -- Input template name
+2 NEW I,J,IBXXC,VALMY
+3 SET IBTSAV("IBTRN")=IBTRN
+4 DO EN^VALM2($GET(XQORNOD(0)))
+5 IF $DATA(VALMY)
SET IBXXC=0
FOR
SET IBXXC=$ORDER(VALMY(IBXXC))
if 'IBXXC
QUIT
Begin DoDot:1
+6 SET IBTRC=$PIECE($GET(^TMP("IBTRCDX",$JOB,+$ORDER(^TMP("IBTRC",$JOB,"IDX",IBXXC,0)))),"^",2)
+7 DO EN^VALM(IBTMPNM)
+8 KILL IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,VAUTD
+9 KILL IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
+10 DO KVAR^VADPT
+11 QUIT
End DoDot:1
+12 SET IBTRN=$GET(IBTSAV("IBTRN"))
+13 IF '$DATA(IBFASTXT)
DO BLD^IBTRC
+14 SET VALMBCK="R"
+15 QUIT
+16 ;
EDIT(IBTEMP) ; -- Edit entries
+1 NEW I,J,IBXX,VALMY
+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
QUIT
Begin DoDot:1
+4 SET IBTRC=$PIECE($GET(^TMP("IBTRCDX",$JOB,+$ORDER(^TMP("IBTRC",$JOB,"IDX",IBXX,0)))),"^",2)
+5 WRITE !!,"Editing Entry #",IBXX,!
+6 DO EDIT^IBTRCD1(IBTEMP,1)
End DoDot:1
+7 SET VALMBCK="R"
+8 DO BLD^IBTRC
+9 QUIT
+10 ;
PRECRT(IBTRN,LNG) ; -- find precert number for a tracking entry
+1 ; -- input ibtrn = internal entry of tracking id.
+2 ;
+3 SET PRECERT=""
+4 IF '$GET(IBTRN)
GOTO PRECQ
+5 SET PRECERT=$ORDER(^IBT(356.2,"APRE",IBTRN,0))
+6 IF +$GET(LNG)
IF $LENGTH(PRECERT)>LNG
SET PRECERT=$EXTRACT(PRECERT,1,(LNG-1))_"*"
PRECQ QUIT PRECERT
+1 ;
SHOWSC ; -- display sc conditions
+1 NEW VAEL,TAB,IBTRCSC
+2 DO FULL^VALM1
+3 DO ELIG^VADPT
+4 WRITE !!,"Patient: ",$$PT^IBTUTL1(DFN)
+5 IF 'VAEL(3)
WRITE !,"Patient Not Service Connected",!!
GOTO SHOWQ
+6 WRITE !,?5,"Service Connected Percent: "_+$PIECE(VAEL(3),"^",2)_"%"
+7 SET TAB=5
SET IBTRCSC=1
DO SC^IBTOAT2
SHOWQ DO PAUSE^VALM1
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
CP ; -- change patient from within insurance reviews
+1 NEW VALMQUIT,IBDFN,IBTRNOLD,IBY
+2 DO FULL^VALM1
+3 SET IBDFN=DFN
DO PAT^IBCNSM
+4 IF $DATA(VALMQUIT)
SET DFN=IBDFN
+5 SET IBTRNOLD=IBTRN
KILL IBTRN
+6 DO TRAC^IBTRV
+7 IF '$GET(IBTRN)
SET DFN=IBDFN
SET IBTRN=IBTRNOLD
+8 SET IBTRND=$GET(^IBT(356,+IBTRN,0))
+9 DO BLD^IBTRC
DO HDR^IBTRC
+10 SET VALMBCK="R"
CPQ QUIT
+1 ;
SCREEN(ACODE,CTYPE) ; -- screen for action field of file 356.2
+1 ; -- called by input transform
+2 ; input ACODE = piece 3 (action code) of entry being screen in 356.7
+3 ; CTYPE = type of review, pointer to 356.11
+4 ;
+5 SET CTYPE=$PIECE($GET(^IBE(356.11,+CTYPE,0)),"^",2)
IF 'CTYPE
QUIT 1
+6 QUIT $SELECT(CTYPE=10:1,CTYPE=20:1,CTYPE=25:1,CTYPE=30:1,CTYPE=35:1,CTYPE=50&(ACODE<30):1,CTYPE=55&(ACODE<30):1,1:0)
+7 ;Q $S(CTYPE=10:1,CTYPE=20:1,CTYPE=30:1,CTYPE=50&(ACODE<30):1,1:0)
+8 ;Q $S(CTYPE=1:1,CTYPE=2&(ACODE'=30):1,CTYPE=3:1,CTYPE=5&(ACODE<30):1,1:0)
