IBTRCD1 ;ALB/AAS/BGA - CLAIMS TRACKING INS ACTION EDIT ;11/8/06 9:34am
;;2.0;INTEGRATED BILLING;**10,359,413,458**;21-MAR-94;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
% G ^IBTRC
;
QE ; -- Quick edit
N IBXX,VALMY,DA,DR,DIC,DIE
D QE1^IBTRC1
D BLD^IBTRCD
S VALMBCK="R"
Q
;
NX(IBTMPNM,BLD) ; -- edit next template
N IBXX,VALMY
D EN^VALM(IBTMPNM)
I '$D(IBFASTXT) D:'$G(BLD) BLD^IBTRCD
I IBTMPNM="IBCNS VIEW PAT INS" D:$G(BLD)=1 BLD^IBTRE ;REBUILD LIST
S VALMBCK="R"
Q
;
EDIT(DR,BLD) ; -- edit entry point for claims tracking reviews
; -- Input IBTEMP = template name or dr string
; BLD = any non-zero value if calling routine is doing own
; rebuild
;
N IBDIF,DA,DIC,DIE,DIR,X,Y,IBTLST
D FULL^VALM1 W !
D SAVE
S DIE="^IBT(356.2,",DA=IBTRC
L +^IBT(356.2,+IBTRC):5 I '$T D LOCKED G EDITQ
D ^DIE K DA,DR,DIC,DIE
I '$D(IBCON) D CON K IBCON
D COMP
I IBDIF=1 D UPDATE
L -^IBT(356.2,+IBTRC)
D BLD^IBTRCD:'$G(BLD)
EDITQ K ^TMP($J,"IBT")
S VALMBCK="R"
Q
;
SAVE ; -- Save the global before editing
K ^TMP($J,"IBT")
S ^TMP($J,"IBT",356.2,IBTRC,0)=$G(^IBT(356.2,IBTRC,0))
S ^TMP($J,"IBT",356.2,IBTRC,1)=$G(^IBT(356.2,IBTRC,1))
S ^TMP($J,"IBT",356.2,IBTRC,2)=$G(^IBT(356.2,IBTRC,2))
S ^TMP($J,"IBT",356.2,IBTRC,11,0)=$G(^IBT(356.2,IBTRC,11,0))
S ^TMP($J,"IBT",356.2,IBTRC,12,0)=$G(^IBT(356.2,IBTRC,12,0))
S ^TMP($J,"IBT",356.2,IBTRC,13,0)=$G(^IBT(356.2,IBTRC,13,0))
Q
;
COMP ; -- Compare before editing with globals
S IBDIF=0
I $G(^IBT(356.2,IBTRC,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,0)) S IBDIF=1 Q
I $G(^IBT(356.2,IBTRC,1))'=$G(^TMP($J,"IBT",356.2,IBTRC,1)) S IBDIF=1 Q
I $G(^IBT(356.2,IBTRC,2))'=$G(^TMP($J,"IBT",356.2,IBTRC,2)) S IBDIF=1 Q
I $G(^IBT(356.2,IBTRC,11,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,11,0)) S IBDIF=1 Q
I $G(^IBT(356.2,IBTRC,12,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,12,0)) S IBDIF=1 Q
I $G(^IBT(356.2,IBTRC,13,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,13,0)) S IBDIF=1 Q
Q
;
UPDATE ; -- enter date and user if editing has taken place
; entry locked during edit lock not needed here
S DIE="^IBT(356.2,",DA=IBTRC
S DR="1.03///NOW;1.04////"_DUZ
D ^DIE K DA,DR,DIC,DIE
Q
;
LOCKED ; -- write locked message
Q:$D(ZTQUEUED)
;Suppress Writes & PAUSE^VALM1 call when used via ICB interface
Q:$G(IBSUPRES)>0
W !!,"Sorry, another user currently editing this entry."
W !,"Try again later."
D PAUSE^VALM1
Q
;
CON ; -- consistency checker for insurance reviews
N I,J,X,Y,DA,DR,DIC,DIE,IBI,IBDEL,IBACTION
S IBCON=1 Q:'$D(^IBT(356.2,IBTRC,0))
S IBACTION=$P($G(^IBE(356.7,+$P(^IBT(356.2,IBTRC,0),"^",11),0)),"^",3)
I $G(IBACTION)="" S IBACTION=99
;
; -- if action and type the same okay, check nxt rv. dates
I $P($G(^IBT(356.2,IBTRC,0)),"^",4)=$P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",4),$P($G(^IBT(356.2,IBTRC,0)),"^",11)=$P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",11) G NXRV
;
; -- if action different
I $P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",11)="" Q ; no previous action
I $P($G(^IBT(356.2,IBTRC,0)),"^",11)'=$P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",11) D
.S DR=$P($T(@(IBACTION)),";;",2,99)
.I DR'="" D EDIT(DR,1)
.I IBACTION'=10 S $P(^IBT(356.2,IBTRC,0),"^",12,13)="^"
.I IBACTION'=20 S $P(^IBT(356.2,IBTRC,0),"^",15,16)="^"
.W !,"WARNING: I detected you changed the Action on this review and deleted",!,"data associated with the previous action." H 3
.Q
; -- if not denial and denial reasons delete
I $O(^IBT(356.2,IBTRC,12,0)),$G(IBACTION)'=20 D
.S IBI=0 F S IBI=$O(^IBT(356.2,IBTRC,12,IBI)) Q:'IBI S DA=IBI,DA(1)=IBTRC,DIK="^IBT(356.2,"_IBTRC_",12," D ^DIK
;
; -- if not penalty and penalty reasons delete
I $O(^IBT(356.2,IBTRC,13,0)),$G(IBACTION)'=30 D
.S IBI=0 F S IBI=$O(^IBT(356.2,IBTRC,13,IBI)) Q:'IBI S DA=IBI,DA(1)=IBTRC,DIK="^IBT(356.2,"_IBTRC_",13," D ^DIK
.Q
;
NXRV ; -- check Next Review Dates
N IBI0,IBIX
I '$D(IBTRN) N IBTRN S IBTRN=$P($G(^IBT(356.2,+$G(IBTRC),0)),"^",2)
Q:'$G(IBTRN)
S IBI=0 F S IBI=$O(^IBT(356.2,"C",IBTRN,IBI)) Q:'IBI D
.I $P($G(^IBT(356.2,IBI,0)),"^",24) D
..S IBI0=$G(^(0))
..S IBI(IBI)=$$DAT1^IBOUTL($P(IBI0,U,24))_"^"_$P($G(^DIC(36,+$P(IBI0,U,8),0)),U,1)_"^"_$P($G(^IBE(356.11,+$P(IBI0,U,4),0)),U,3)
..Q
.Q
I $O(IBI(0)) D ASKDEL I IBDEL D
.I $P(^IBT(356.2,IBTRC,0),U,24)!$O(IBI(+$O(IBI(0)))) D
..W !!,?3,"WARNING: This patient has the following multiple Next Review Dates: "
..W !!!,?5,"REVIEW",?18,"INSURANCE COMPANY",?45,"TYPE OF CONTACT",?65,"NEXT REV. DATE"
..W !,?5,$TR($J(" ",IOM-5)," ","=")
..S IBIX=0 F S IBIX=$O(IBI(IBIX)) Q:'IBIX D
...W !,?5,$$DAT1^IBOUTL(+^IBT(356.2,IBIX,0)),?18,$E($P(IBI(IBIX),U,2),1,23),?45,$P(IBI(IBIX),U,3),?65,$P(IBI(IBIX),U,1)
...Q
..W !,?5,$TR($J(" ",IOM-5)," ","=") S DIR("A")="Press RETURN to continue" D PAUSE^IBOUTL Q
Q
;
ASKDEL ; -- ask if okay to delete next review dates
S IBDEL=1
Q
;
10 ;;1.07///@;.2///@;.21///@
20 ;;.14///@;1.08///@;.2///@;21///@;2.02///@
30 ;;.14///@;1.07///@;1.08///@;.2///@;21///@;2.02///@
40 ;;.14///@;1.07///@;1.08///@;21///@;2.02///@
50 ;;.14///@;1.07///@;1.08///@;.2///@;2.02///@
99 ;;.14///@;1.07///@;1.08///@;.2///@;21///@;2.02///@
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRCD1 5250 printed Nov 22, 2024@17:37:43 Page 2
IBTRCD1 ;ALB/AAS/BGA - CLAIMS TRACKING INS ACTION EDIT ;11/8/06 9:34am
+1 ;;2.0;INTEGRATED BILLING;**10,359,413,458**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
% GOTO ^IBTRC
+1 ;
QE ; -- Quick edit
+1 NEW IBXX,VALMY,DA,DR,DIC,DIE
+2 DO QE1^IBTRC1
+3 DO BLD^IBTRCD
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
NX(IBTMPNM,BLD) ; -- edit next template
+1 NEW IBXX,VALMY
+2 DO EN^VALM(IBTMPNM)
+3 IF '$DATA(IBFASTXT)
if '$GET(BLD)
DO BLD^IBTRCD
+4 ;REBUILD LIST
IF IBTMPNM="IBCNS VIEW PAT INS"
if $GET(BLD)=1
DO BLD^IBTRE
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
EDIT(DR,BLD) ; -- edit entry point for claims tracking reviews
+1 ; -- Input IBTEMP = template name or dr string
+2 ; BLD = any non-zero value if calling routine is doing own
+3 ; rebuild
+4 ;
+5 NEW IBDIF,DA,DIC,DIE,DIR,X,Y,IBTLST
+6 DO FULL^VALM1
WRITE !
+7 DO SAVE
+8 SET DIE="^IBT(356.2,"
SET DA=IBTRC
+9 LOCK +^IBT(356.2,+IBTRC):5
IF '$TEST
DO LOCKED
GOTO EDITQ
+10 DO ^DIE
KILL DA,DR,DIC,DIE
+11 IF '$DATA(IBCON)
DO CON
KILL IBCON
+12 DO COMP
+13 IF IBDIF=1
DO UPDATE
+14 LOCK -^IBT(356.2,+IBTRC)
+15 if '$GET(BLD)
DO BLD^IBTRCD
EDITQ KILL ^TMP($JOB,"IBT")
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
SAVE ; -- Save the global before editing
+1 KILL ^TMP($JOB,"IBT")
+2 SET ^TMP($JOB,"IBT",356.2,IBTRC,0)=$GET(^IBT(356.2,IBTRC,0))
+3 SET ^TMP($JOB,"IBT",356.2,IBTRC,1)=$GET(^IBT(356.2,IBTRC,1))
+4 SET ^TMP($JOB,"IBT",356.2,IBTRC,2)=$GET(^IBT(356.2,IBTRC,2))
+5 SET ^TMP($JOB,"IBT",356.2,IBTRC,11,0)=$GET(^IBT(356.2,IBTRC,11,0))
+6 SET ^TMP($JOB,"IBT",356.2,IBTRC,12,0)=$GET(^IBT(356.2,IBTRC,12,0))
+7 SET ^TMP($JOB,"IBT",356.2,IBTRC,13,0)=$GET(^IBT(356.2,IBTRC,13,0))
+8 QUIT
+9 ;
COMP ; -- Compare before editing with globals
+1 SET IBDIF=0
+2 IF $GET(^IBT(356.2,IBTRC,0))'=$GET(^TMP($JOB,"IBT",356.2,IBTRC,0))
SET IBDIF=1
QUIT
+3 IF $GET(^IBT(356.2,IBTRC,1))'=$GET(^TMP($JOB,"IBT",356.2,IBTRC,1))
SET IBDIF=1
QUIT
+4 IF $GET(^IBT(356.2,IBTRC,2))'=$GET(^TMP($JOB,"IBT",356.2,IBTRC,2))
SET IBDIF=1
QUIT
+5 IF $GET(^IBT(356.2,IBTRC,11,0))'=$GET(^TMP($JOB,"IBT",356.2,IBTRC,11,0))
SET IBDIF=1
QUIT
+6 IF $GET(^IBT(356.2,IBTRC,12,0))'=$GET(^TMP($JOB,"IBT",356.2,IBTRC,12,0))
SET IBDIF=1
QUIT
+7 IF $GET(^IBT(356.2,IBTRC,13,0))'=$GET(^TMP($JOB,"IBT",356.2,IBTRC,13,0))
SET IBDIF=1
QUIT
+8 QUIT
+9 ;
UPDATE ; -- enter date and user if editing has taken place
+1 ; entry locked during edit lock not needed here
+2 SET DIE="^IBT(356.2,"
SET DA=IBTRC
+3 SET DR="1.03///NOW;1.04////"_DUZ
+4 DO ^DIE
KILL DA,DR,DIC,DIE
+5 QUIT
+6 ;
LOCKED ; -- write locked message
+1 if $DATA(ZTQUEUED)
QUIT
+2 ;Suppress Writes & PAUSE^VALM1 call when used via ICB interface
+3 if $GET(IBSUPRES)>0
QUIT
+4 WRITE !!,"Sorry, another user currently editing this entry."
+5 WRITE !,"Try again later."
+6 DO PAUSE^VALM1
+7 QUIT
+8 ;
CON ; -- consistency checker for insurance reviews
+1 NEW I,J,X,Y,DA,DR,DIC,DIE,IBI,IBDEL,IBACTION
+2 SET IBCON=1
if '$DATA(^IBT(356.2,IBTRC,0))
QUIT
+3 SET IBACTION=$PIECE($GET(^IBE(356.7,+$PIECE(^IBT(356.2,IBTRC,0),"^",11),0)),"^",3)
+4 IF $GET(IBACTION)=""
SET IBACTION=99
+5 ;
+6 ; -- if action and type the same okay, check nxt rv. dates
+7 IF $PIECE($GET(^IBT(356.2,IBTRC,0)),"^",4)=$PIECE($GET(^TMP($JOB,"IBT",356.2,IBTRC,0)),"^",4)
IF $PIECE($GET(^IBT(356.2,IBTRC,0)),"^",11)=$PIECE($GET(^TMP($JOB,"IBT",356.2,IBTRC,0)),"^",11)
GOTO NXRV
+8 ;
+9 ; -- if action different
+10 ; no previous action
IF $PIECE($GET(^TMP($JOB,"IBT",356.2,IBTRC,0)),"^",11)=""
QUIT
+11 IF $PIECE($GET(^IBT(356.2,IBTRC,0)),"^",11)'=$PIECE($GET(^TMP($JOB,"IBT",356.2,IBTRC,0)),"^",11)
Begin DoDot:1
+12 SET DR=$PIECE($TEXT(@(IBACTION)),";;",2,99)
+13 IF DR'=""
DO EDIT(DR,1)
+14 IF IBACTION'=10
SET $PIECE(^IBT(356.2,IBTRC,0),"^",12,13)="^"
+15 IF IBACTION'=20
SET $PIECE(^IBT(356.2,IBTRC,0),"^",15,16)="^"
+16 WRITE !,"WARNING: I detected you changed the Action on this review and deleted",!,"data associated with the previous action."
HANG 3
+17 QUIT
End DoDot:1
+18 ; -- if not denial and denial reasons delete
+19 IF $ORDER(^IBT(356.2,IBTRC,12,0))
IF $GET(IBACTION)'=20
Begin DoDot:1
+20 SET IBI=0
FOR
SET IBI=$ORDER(^IBT(356.2,IBTRC,12,IBI))
if 'IBI
QUIT
SET DA=IBI
SET DA(1)=IBTRC
SET DIK="^IBT(356.2,"_IBTRC_",12,"
DO ^DIK
End DoDot:1
+21 ;
+22 ; -- if not penalty and penalty reasons delete
+23 IF $ORDER(^IBT(356.2,IBTRC,13,0))
IF $GET(IBACTION)'=30
Begin DoDot:1
+24 SET IBI=0
FOR
SET IBI=$ORDER(^IBT(356.2,IBTRC,13,IBI))
if 'IBI
QUIT
SET DA=IBI
SET DA(1)=IBTRC
SET DIK="^IBT(356.2,"_IBTRC_",13,"
DO ^DIK
+25 QUIT
End DoDot:1
+26 ;
NXRV ; -- check Next Review Dates
+1 NEW IBI0,IBIX
+2 IF '$DATA(IBTRN)
NEW IBTRN
SET IBTRN=$PIECE($GET(^IBT(356.2,+$GET(IBTRC),0)),"^",2)
+3 if '$GET(IBTRN)
QUIT
+4 SET IBI=0
FOR
SET IBI=$ORDER(^IBT(356.2,"C",IBTRN,IBI))
if 'IBI
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^IBT(356.2,IBI,0)),"^",24)
Begin DoDot:2
+6 SET IBI0=$GET(^(0))
+7 SET IBI(IBI)=$$DAT1^IBOUTL($PIECE(IBI0,U,24))_"^"_$PIECE($GET(^DIC(36,+$PIECE(IBI0,U,8),0)),U,1)_"^"_$PIECE($GET(^IBE(356.11,+$PIECE(IBI0,U,4),0)),U,3)
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 IF $ORDER(IBI(0))
DO ASKDEL
IF IBDEL
Begin DoDot:1
+11 IF $PIECE(^IBT(356.2,IBTRC,0),U,24)!$ORDER(IBI(+$ORDER(IBI(0))))
Begin DoDot:2
+12 WRITE !!,?3,"WARNING: This patient has the following multiple Next Review Dates: "
+13 WRITE !!!,?5,"REVIEW",?18,"INSURANCE COMPANY",?45,"TYPE OF CONTACT",?65,"NEXT REV. DATE"
+14 WRITE !,?5,$TRANSLATE($JUSTIFY(" ",IOM-5)," ","=")
+15 SET IBIX=0
FOR
SET IBIX=$ORDER(IBI(IBIX))
if 'IBIX
QUIT
Begin DoDot:3
+16 WRITE !,?5,$$DAT1^IBOUTL(+^IBT(356.2,IBIX,0)),?18,$EXTRACT($PIECE(IBI(IBIX),U,2),1,23),?45,$PIECE(IBI(IBIX),U,3),?65,$PIECE(IBI(IBIX),U,1)
+17 QUIT
End DoDot:3
+18 WRITE !,?5,$TRANSLATE($JUSTIFY(" ",IOM-5)," ","=")
SET DIR("A")="Press RETURN to continue"
DO PAUSE^IBOUTL
QUIT
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
ASKDEL ; -- ask if okay to delete next review dates
+1 SET IBDEL=1
+2 QUIT
+3 ;
10 ;;1.07///@;.2///@;.21///@
20 ;;.14///@;1.08///@;.2///@;21///@;2.02///@
30 ;;.14///@;1.07///@;1.08///@;.2///@;21///@;2.02///@
40 ;;.14///@;1.07///@;1.08///@;21///@;2.02///@
50 ;;.14///@;1.07///@;1.08///@;.2///@;2.02///@
99 ;;.14///@;1.07///@;1.08///@;.2///@;21///@;2.02///@
