IBTRCD1 ;ALB/AAS - CLAIMS TRACKING INS ACTION EDIT ; 06-JUL-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, 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
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,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,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)
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
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
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 I IBI'=IBTRC D
.I $P($G(^IBT(356.2,IBI,0)),"^",24) S IBI(IBI)=""
.Q
I $O(IBI(0)) D ASKDEL I IBDEL D
.I $P(^IBT(356.2,IBTRC,0),U,24) W !,"Warning: There are other reviews with Next Review Dates specified.",!,"Generally only the last review date should have a Next Review Date." H 3 Q
.I $O(IBI(+$O(IBI(0)))) W !,"Warning: More that one review has a Next Review Date Specified.",!,"Generally only the last review date should have a Next Review Date." H 3 Q
.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///@;.28///@
30 ;;.14///@;1.07///@;1.08///@;.2///@;21///@;.28///@
40 ;;.14///@;1.07///@;1.08///@;21///@;.28///@
50 ;;.14///@;1.07///@;1.08///@;.2///@;.28///@
99 ;;.14///@;1.07///@;1.08///@;.2///@;21///@;.28///@
IBTRCD1 ;ALB/AAS - CLAIMS TRACKING INS ACTION EDIT ; 06-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 ^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 SET VALMBCK="R"
+5 QUIT
+6 ;
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,11,0)=$GET(^IBT(356.2,IBTRC,11,0))
+5 SET ^TMP($JOB,"IBT",356.2,IBTRC,12,0)=$GET(^IBT(356.2,IBTRC,12,0))
+6 SET ^TMP($JOB,"IBT",356.2,IBTRC,13,0)=$GET(^IBT(356.2,IBTRC,13,0))
+7 QUIT
+8 ;
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,11,0))'=$GET(^TMP($JOB,"IBT",356.2,IBTRC,11,0))
SET IBDIF=1
QUIT
+5 IF $GET(^IBT(356.2,IBTRC,12,0))'=$GET(^TMP($JOB,"IBT",356.2,IBTRC,12,0))
SET IBDIF=1
QUIT
+6 IF $GET(^IBT(356.2,IBTRC,13,0))'=$GET(^TMP($JOB,"IBT",356.2,IBTRC,13,0))
SET IBDIF=1
QUIT
+7 QUIT
+8 ;
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 WRITE !!,"Sorry, another user currently editing this entry."
+3 WRITE !,"Try again later."
+4 DO PAUSE^VALM1
+5 QUIT
+6 ;
CON ; -- consistency checker for insurance reviews
+1 NEW I,J,X,Y,DA,DR,DIC,DIE,IBI,IBDEL,IBACTION
+2 SET IBCON=1
+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 IF '$DATA(IBTRN)
NEW IBTRN
SET IBTRN=$PIECE($GET(^IBT(356.2,+$GET(IBTRC),0)),"^",2)
+2 IF '$GET(IBTRN)
QUIT
+3 SET IBI=0
FOR
SET IBI=$ORDER(^IBT(356.2,"C",IBTRN,IBI))
IF 'IBI
QUIT
IF IBI'=IBTRC
Begin DoDot:1
+4 IF $PIECE($GET(^IBT(356.2,IBI,0)),"^",24)
SET IBI(IBI)=""
+5 QUIT
End DoDot:1
+6 IF $ORDER(IBI(0))
DO ASKDEL
IF IBDEL
Begin DoDot:1
+7 IF $PIECE(^IBT(356.2,IBTRC,0),U,24)
WRITE !,"Warning: There are other reviews with Next Review Dates specified.",!,"Generally only the last review date should have a Next Review Date."
HANG 3
QUIT
+8 IF $ORDER(IBI(+$ORDER(IBI(0))))
WRITE !,"Warning: More that one review has a Next Review Date Specified.",!,"Generally only the last review date should have a Next Review Date."
HANG 3
QUIT
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
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///@;.28///@
30 ;;.14///@;1.07///@;1.08///@;.2///@;21///@;.28///@
40 ;;.14///@;1.07///@;1.08///@;21///@;.28///@
50 ;;.14///@;1.07///@;1.08///@;.2///@;.28///@
99 ;;.14///@;1.07///@;1.08///@;.2///@;21///@;.28///@
