IBTRV1 ;ALB/AAS - CLAIMS TRACKING - REVIEW ACTIONS ; 14-JUL-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% G EN^IBTRV
;
DT ; -- Delete tracking 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
I $D(VALMY) D FULL^VALM1 S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX!$D(DIRUT) D
.S IBTRV=$P($G(^TMP("IBTRVDX",$J,+$O(^TMP("IBTRV",$J,"IDX",IBXX,0)))),"^",2)
.I $O(^IBT(356.2,"AD",IBTRV,0)) W !!,*7,"There are Insurance Reviews associated with this entry."
.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^IBTRV
S VALMBCK="R" Q
;
DP1 ; -- actual deletion
N DA,DIC,DIK
;
; -- delete reviews, communications,
N IBI,IBCNT
S (IBI,IBCNT)=0 F S IBI=$O(^IBT(356.2,"AD",IBTRV,IBI)) Q:'IBI D
.S DA=IBI,DIK="^IBT(356.2," D ^DIK
.S IBCNT=IBCNT+1
I IBCNT W !,"Number of Insurance Reviews Deleted: ",IBCNT
;
; -- delete entry in review file
S DA=IBTRV,DIK="^IBT(356.1," D ^DIK
W !,"Entry ",IBXX," Deleted"
Q
;
QE ; -- Quick edit Review entry
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 IBTRV=$P($G(^TMP("IBTRVDX",$J,+$O(^TMP("IBTRV",$J,"IDX",IBXX,0)))),"^",2)
.D QE1
QEQ S VALMBCK="R"
D BLD^IBTRV
Q
;
QE1 N X,Y,DA,DR,DIC,DIE,IBSPEC,IBPROV,IBUNIT,IBADT,IBSEL
S DIE="^IBT(356.1,",DA=IBTRV
S IBTRTP=$P($G(^IBE(356.11,+$P($G(^IBT(356.1,IBTRV,0)),"^",22),0)),"^",2)
S IBPROV="",IBSPEC="",IBATD=""
I 'IBTRTP Q
D @(IBTRTP_"^IBTRV3") ;sets up dr string for review type
S DR=DR_"1.15;1.17;.21////10;.21;.2;"
D EDIT^IBTRVD1(.DR,1)
Q ; -- don't always ask clinical info
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 VALMY,I,J,IBXXV
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXXV=0 F S IBXXV=$O(VALMY(IBXXV)) Q:'IBXXV D
.S IBTRV=$P($G(^TMP("IBTRVDX",$J,$O(^TMP("IBTRV",$J,"IDX",IBXXV,0)))),"^",2)
.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^IBTRV
S VALMBCK="R"
Q
;
EDIT(IBTEMP) ; -- Edit entries
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 IBTRV=$P($G(^TMP("IBTRVDX",$J,+$O(^TMP("IBTRV",$J,"IDX",IBXX,0)))),"^",2)
.W !!,"Editing Entry #",IBXX,!
.D EDIT^IBTRVD1(IBTEMP,1)
S VALMBCK="R"
D BLD^IBTRV
Q
;
CP ; -- change patient from within insurance reviews
N VALMQUIT,IBDFN,IBY,IBTRNOLD
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 HDR^IBTRV,BLD^IBTRV
S VALMBCK="R"
CPQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRV1 3401 printed Dec 13, 2024@02:28:56 Page 2
IBTRV1 ;ALB/AAS - CLAIMS TRACKING - REVIEW ACTIONS ; 14-JUL-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^IBTRV
+1 ;
DT ; -- Delete tracking 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
+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 IBTRV=$PIECE($GET(^TMP("IBTRVDX",$JOB,+$ORDER(^TMP("IBTRV",$JOB,"IDX",IBXX,0)))),"^",2)
+6 IF $ORDER(^IBT(356.2,"AD",IBTRV,0))
WRITE !!,*7,"There are Insurance Reviews associated with this entry."
+7 WRITE !
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are You Sure you want to delete entry #"_IBXX
+8 DO ^DIR
IF Y'=1
WRITE !,"Entry #",IBXX," not Deleted!"
QUIT
+9 DO DP1
+10 QUIT
End DoDot:1
DTQ DO BLD^IBTRV
+1 SET VALMBCK="R"
QUIT
+2 ;
DP1 ; -- actual deletion
+1 NEW DA,DIC,DIK
+2 ;
+3 ; -- delete reviews, communications,
+4 NEW IBI,IBCNT
+5 SET (IBI,IBCNT)=0
FOR
SET IBI=$ORDER(^IBT(356.2,"AD",IBTRV,IBI))
if 'IBI
QUIT
Begin DoDot:1
+6 SET DA=IBI
SET DIK="^IBT(356.2,"
DO ^DIK
+7 SET IBCNT=IBCNT+1
End DoDot:1
+8 IF IBCNT
WRITE !,"Number of Insurance Reviews Deleted: ",IBCNT
+9 ;
+10 ; -- delete entry in review file
+11 SET DA=IBTRV
SET DIK="^IBT(356.1,"
DO ^DIK
+12 WRITE !,"Entry ",IBXX," Deleted"
+13 QUIT
+14 ;
QE ; -- Quick edit Review entry
+1 DO EN^VALM2($GET(XQORNOD(0)))
+2 NEW I,J,IBXX
+3 IF $DATA(VALMY)
DO FULL^VALM1
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+4 SET IBTRV=$PIECE($GET(^TMP("IBTRVDX",$JOB,+$ORDER(^TMP("IBTRV",$JOB,"IDX",IBXX,0)))),"^",2)
+5 DO QE1
End DoDot:1
QEQ SET VALMBCK="R"
+1 DO BLD^IBTRV
+2 QUIT
+3 ;
QE1 NEW X,Y,DA,DR,DIC,DIE,IBSPEC,IBPROV,IBUNIT,IBADT,IBSEL
+1 SET DIE="^IBT(356.1,"
SET DA=IBTRV
+2 SET IBTRTP=$PIECE($GET(^IBE(356.11,+$PIECE($GET(^IBT(356.1,IBTRV,0)),"^",22),0)),"^",2)
+3 SET IBPROV=""
SET IBSPEC=""
SET IBATD=""
+4 IF 'IBTRTP
QUIT
+5 ;sets up dr string for review type
DO @(IBTRTP_"^IBTRV3")
+6 SET DR=DR_"1.15;1.17;.21////10;.21;.2;"
+7 DO EDIT^IBTRVD1(.DR,1)
+8 ; -- don't always ask clinical info
QUIT
+9 ;clinical info only on inpt/outpt
IF $$TRTP^IBTRE1(IBTRN)<3
Begin DoDot:1
+10 ; -- diagnosis edit
+11 DO EN^IBTRE3(IBTRN)
if $GET(IBSEL)["^"
QUIT
+12 ;
+13 ; -- procedure edit / only inpt. / outpt use add/edit
+14 IF $$TRTP^IBTRE1(IBTRN)<2
DO EN^IBTRE4(IBTRN)
if $GET(IBSEL)["^"
QUIT
+15 ;
+16 ; -- provider edit
+17 DO EN^IBTRE5(IBTRN)
End DoDot:1
+18 QUIT
+19 ;
NX(IBTMPNM) ; -- Go to next template
+1 ; -- Input template name
+2 NEW VALMY,I,J,IBXXV
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXXV=0
FOR
SET IBXXV=$ORDER(VALMY(IBXXV))
if 'IBXXV
QUIT
Begin DoDot:1
+5 SET IBTRV=$PIECE($GET(^TMP("IBTRVDX",$JOB,$ORDER(^TMP("IBTRV",$JOB,"IDX",IBXXV,0)))),"^",2)
+6 DO EN^VALM(IBTMPNM)
+7 KILL IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
+8 KILL IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
+9 DO KVAR^VADPT
+10 QUIT
End DoDot:1
+11 IF '$DATA(IBFASTXT)
DO BLD^IBTRV
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
EDIT(IBTEMP) ; -- Edit entries
+1 DO EN^VALM2($GET(XQORNOD(0)))
+2 NEW I,J,IBXX
+3 IF $DATA(VALMY)
DO FULL^VALM1
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+4 SET IBTRV=$PIECE($GET(^TMP("IBTRVDX",$JOB,+$ORDER(^TMP("IBTRV",$JOB,"IDX",IBXX,0)))),"^",2)
+5 WRITE !!,"Editing Entry #",IBXX,!
+6 DO EDIT^IBTRVD1(IBTEMP,1)
End DoDot:1
+7 SET VALMBCK="R"
+8 DO BLD^IBTRV
+9 QUIT
+10 ;
CP ; -- change patient from within insurance reviews
+1 NEW VALMQUIT,IBDFN,IBY,IBTRNOLD
+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 HDR^IBTRV
DO BLD^IBTRV
+10 SET VALMBCK="R"
CPQ QUIT
