IBTRVD1 ;ALB/AAS - CLAIMS TRACKING REVIEW EDIT ; 06-JUL-93
;;Version 2.0 ; INTEGRATED BILLING ;**1,10**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% G ^IBTRV
;
QE ; -- Review Criteria edit
N IBXX,VALMY,DA,DR,DIC,DIE
D QE1^IBTRV1
D BLD^IBTRVD
S VALMBCK="R"
Q
;
NX(IBTMPNM,BLD) ; -- edit next template
N IBXX,VALMY,IBTRC
D EN^VALM(IBTMPNM)
I '$D(IBFASTXT),'$G(BLD) D BLD^IBTRVD
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
D FULL^VALM1 W !
L +^IBT(356.1,+IBTRV):5 I '$T D LOCKED^IBTRCD1 G EDITQ
D SAVE
S DIE="^IBT(356.1,",DA=IBTRV
D ^DIE K DA,DR,DIC,DIE
D COMP
I '$D(IBCON) D CON K IBCON
I IBDIF=1 D UPDATE,BLD^IBTRVD:'$G(BLD)
L -^IBT(356.1,+IBTRN)
EDITQ K ^TMP($J,"IBT")
S VALMBCK="R"
Q
;
SAVE ; -- Save the global before editing
K ^TMP($J,"IBT")
S ^TMP($J,"IBT",356.1,IBTRV,0)=$G(^IBT(356.1,IBTRV,0))
S ^TMP($J,"IBT",356.1,IBTRV,1)=$G(^IBT(356.1,IBTRV,1))
S ^TMP($J,"IBT",356.1,IBTRV,11,0)=$G(^IBT(356.1,IBTRV,11,0))
Q
;
COMP ; -- Compare before editing with globals
S IBDIF=0
I $G(^IBT(356.1,IBTRV,0))'=$G(^TMP($J,"IBT",356.1,IBTRV,0)) S IBDIF=1 Q
I $G(^IBT(356.1,IBTRV,1))'=$G(^TMP($J,"IBT",356.1,IBTRV,1)) S IBDIF=1 Q
I $G(^IBT(356.1,IBTRV,11,0))'=$G(^TMP($J,"IBT",356.1,IBTRV,11,0)) S IBDIF=1 Q
Q
;
UPDATE ; -- enter date and user if editing has taken place
; entry locked by edit, locks not needed here
S DIE="^IBT(356.1,",DA=IBTRV
S DR="1.03///NOW;1.04////"_DUZ
D ^DIE K DA,DR,DIC,DIE
Q
;
CON ; -- consistency checker for hospital reviews
Q:$G(^IBT(356.1,IBTRV,0))=""
N I,J,X,Y,DA,DR,DIC,DIE,IBI,IBTRTP,IBDEL
S IBCON=1
S IBTRTP=$P($G(^IBE(356.11,+$P($G(^IBT(356.1,IBTRV,0)),"^",22),0)),"^",2)
; -- if admission review
I IBTRTP=15 D
.S X=$G(^IBT(356.1,IBTRV,0))
.I '$P(X,"^",4),'$P(X,"^",5),'$P(X,"^",6),'$O(^IBT(356.1,IBTRV,12,0)) W !!,*7,"Warning: Admission Criteria does NOT appear to be met but Reason for",!,"Non Acute Admission Missing." D EDIT("12",1)
.I $P(X,"^",4),($P(X,"^",5)),($P(X,"^",6)),$O(^IBT(356.1,IBTRV,12,0)) W !!,*7,"Warning: Admission Criteria appears to be met but has Reason for ",!,"Non Acute Admission." D EDIT("12",1)
.Q
; -- if cont. stay review
I IBTRTP=30 D
.S X=$G(^IBT(356.1,IBTRV,0))
.I '$P(X,"^",4),'$P(X,"^",5),$P(X,"^",12),'$O(^IBT(356.1,IBTRV,13,0)) W !!,*7,"Warning: Acute Care Criteria does NOT appear to be met but Reason for",!,"Non Acute Days Missing." D EDIT(13,1)
.I $P(X,"^",4),($P(X,"^",5)),$O(^IBT(356.1,IBTRV,13,0)) W !!,*7,"Warning: Acute Care Criteria appears to be met but has Reason for ",!,"Non Acute Days." D EDIT(13,1)
.Q
; -- check Next Review Dates
S IBI=0 F S IBI=$O(^IBT(356.1,"C",IBTRN,IBI)) Q:'IBI I IBI'=IBTRV D
.I $P($G(^IBT(356.1,IBI,0)),"^",20) S IBI(IBI)=""
.Q
I $O(IBI(0)) D ASKDEL I IBDEL D
.I $P(^IBT(356.1,IBTRV,0),U,20) D
..W !," There are other reviews for this admission with a next review date"
..W !," specified. Generally, only the last review for an admission should"
..W !," have a next review date. Please check the reviews for this case and"
..W !," delete all unnecessary 'next review dates'."
..H 3 Q
.I $O(IBI(+$O(IBI(0)))) D
.;S IBI=0 F S IBI=$O(IBI(IBI)) Q:'IBI S DA=IBI,DR=".2///@",DIE="^IBT(356.1," D ^DIE
.;W !,"Next Review Dates have all been deleted, except for this review"
.Q
Q
;
ASKDEL ; -- ask if okay to delete next review dates
S IBDEL=1
Q
;
IA(IBTRV,BLD) ; -- Insurance action
; -- add/edit communications in bkgrnd for a review
; quick edit a communications entry.
;
I '$G(BLD) D BLD^IBTRVD
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRVD1 3884 printed Oct 16, 2024@18:29:39 Page 2
IBTRVD1 ;ALB/AAS - CLAIMS TRACKING REVIEW EDIT ; 06-JUL-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**1,10**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% GOTO ^IBTRV
+1 ;
QE ; -- Review Criteria edit
+1 NEW IBXX,VALMY,DA,DR,DIC,DIE
+2 DO QE1^IBTRV1
+3 DO BLD^IBTRVD
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
NX(IBTMPNM,BLD) ; -- edit next template
+1 NEW IBXX,VALMY,IBTRC
+2 DO EN^VALM(IBTMPNM)
+3 IF '$DATA(IBFASTXT)
IF '$GET(BLD)
DO BLD^IBTRVD
+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
+6 DO FULL^VALM1
WRITE !
+7 LOCK +^IBT(356.1,+IBTRV):5
IF '$TEST
DO LOCKED^IBTRCD1
GOTO EDITQ
+8 DO SAVE
+9 SET DIE="^IBT(356.1,"
SET DA=IBTRV
+10 DO ^DIE
KILL DA,DR,DIC,DIE
+11 DO COMP
+12 IF '$DATA(IBCON)
DO CON
KILL IBCON
+13 IF IBDIF=1
DO UPDATE
if '$GET(BLD)
DO BLD^IBTRVD
+14 LOCK -^IBT(356.1,+IBTRN)
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.1,IBTRV,0)=$GET(^IBT(356.1,IBTRV,0))
+3 SET ^TMP($JOB,"IBT",356.1,IBTRV,1)=$GET(^IBT(356.1,IBTRV,1))
+4 SET ^TMP($JOB,"IBT",356.1,IBTRV,11,0)=$GET(^IBT(356.1,IBTRV,11,0))
+5 QUIT
+6 ;
COMP ; -- Compare before editing with globals
+1 SET IBDIF=0
+2 IF $GET(^IBT(356.1,IBTRV,0))'=$GET(^TMP($JOB,"IBT",356.1,IBTRV,0))
SET IBDIF=1
QUIT
+3 IF $GET(^IBT(356.1,IBTRV,1))'=$GET(^TMP($JOB,"IBT",356.1,IBTRV,1))
SET IBDIF=1
QUIT
+4 IF $GET(^IBT(356.1,IBTRV,11,0))'=$GET(^TMP($JOB,"IBT",356.1,IBTRV,11,0))
SET IBDIF=1
QUIT
+5 QUIT
+6 ;
UPDATE ; -- enter date and user if editing has taken place
+1 ; entry locked by edit, locks not needed here
+2 SET DIE="^IBT(356.1,"
SET DA=IBTRV
+3 SET DR="1.03///NOW;1.04////"_DUZ
+4 DO ^DIE
KILL DA,DR,DIC,DIE
+5 QUIT
+6 ;
CON ; -- consistency checker for hospital reviews
+1 if $GET(^IBT(356.1,IBTRV,0))=""
QUIT
+2 NEW I,J,X,Y,DA,DR,DIC,DIE,IBI,IBTRTP,IBDEL
+3 SET IBCON=1
+4 SET IBTRTP=$PIECE($GET(^IBE(356.11,+$PIECE($GET(^IBT(356.1,IBTRV,0)),"^",22),0)),"^",2)
+5 ; -- if admission review
+6 IF IBTRTP=15
Begin DoDot:1
+7 SET X=$GET(^IBT(356.1,IBTRV,0))
+8 IF '$PIECE(X,"^",4)
IF '$PIECE(X,"^",5)
IF '$PIECE(X,"^",6)
IF '$ORDER(^IBT(356.1,IBTRV,12,0))
WRITE !!,*7,"Warning: Admission Criteria does NOT appear to be met but Reason for",!,"Non Acute Admission Missing."
DO EDIT("12",1)
+9 IF $PIECE(X,"^",4)
IF ($PIECE(X,"^",5))
IF ($PIECE(X,"^",6))
IF $ORDER(^IBT(356.1,IBTRV,12,0))
WRITE !!,*7,"Warning: Admission Criteria appears to be met but has Reason for ",!,"Non Acute Admission."
DO EDIT("12",1)
+10 QUIT
End DoDot:1
+11 ; -- if cont. stay review
+12 IF IBTRTP=30
Begin DoDot:1
+13 SET X=$GET(^IBT(356.1,IBTRV,0))
+14 IF '$PIECE(X,"^",4)
IF '$PIECE(X,"^",5)
IF $PIECE(X,"^",12)
IF '$ORDER(^IBT(356.1,IBTRV,13,0))
WRITE !!,*7,"Warning: Acute Care Criteria does NOT appear to be met but Reason for",!,"Non Acute Days Missing."
DO EDIT(13,1)
+15 IF $PIECE(X,"^",4)
IF ($PIECE(X,"^",5))
IF $ORDER(^IBT(356.1,IBTRV,13,0))
WRITE !!,*7,"Warning: Acute Care Criteria appears to be met but has Reason for ",!,"Non Acute Days."
DO EDIT(13,1)
+16 QUIT
End DoDot:1
+17 ; -- check Next Review Dates
+18 SET IBI=0
FOR
SET IBI=$ORDER(^IBT(356.1,"C",IBTRN,IBI))
if 'IBI
QUIT
IF IBI'=IBTRV
Begin DoDot:1
+19 IF $PIECE($GET(^IBT(356.1,IBI,0)),"^",20)
SET IBI(IBI)=""
+20 QUIT
End DoDot:1
+21 IF $ORDER(IBI(0))
DO ASKDEL
IF IBDEL
Begin DoDot:1
+22 IF $PIECE(^IBT(356.1,IBTRV,0),U,20)
Begin DoDot:2
+23 WRITE !," There are other reviews for this admission with a next review date"
+24 WRITE !," specified. Generally, only the last review for an admission should"
+25 WRITE !," have a next review date. Please check the reviews for this case and"
+26 WRITE !," delete all unnecessary 'next review dates'."
+27 HANG 3
QUIT
End DoDot:2
+28 IF $ORDER(IBI(+$ORDER(IBI(0))))
Begin DoDot:2
End DoDot:2
+29 ;S IBI=0 F S IBI=$O(IBI(IBI)) Q:'IBI S DA=IBI,DR=".2///@",DIE="^IBT(356.1," D ^DIE
+30 ;W !,"Next Review Dates have all been deleted, except for this review"
+31 QUIT
End DoDot:1
+32 QUIT
+33 ;
ASKDEL ; -- ask if okay to delete next review dates
+1 SET IBDEL=1
+2 QUIT
+3 ;
IA(IBTRV,BLD) ; -- Insurance action
+1 ; -- add/edit communications in bkgrnd for a review
+2 ; quick edit a communications entry.
+3 ;
+4 IF '$GET(BLD)
DO BLD^IBTRVD
+5 SET VALMBCK="R"
+6 QUIT
