IBTRV3 ;ALB/AAS - CLAIMS TRACKING - REVIEW ACTIONS ; 14-JUL-93
;;Version 2.0 ; INTEGRATED BILLING ;**40,58**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% G EN^IBTRV
;
ADNXT(IBTRN) ; -- Add next Hospital Review
; -- Input ibtrn = internal entry in claims tracking (356)
;
N IBETYP,IBTRTP,IBQUIT,IBDGPM,IBTRVDT,IBTRV,IBRDAY,IBMORE,IBSAME,IBSEL
D FULL^VALM1
S VALMBCK="R",IBQUIT=0
S IBTRVDT=DT
S IBETYP=$$TRTP^IBTRE1(IBTRN)
I IBETYP>2 W !!,"This doesn't appear to be an admission or outpatient visit.",!,"I don't know how to review this.",! D PAUSE^VALM1 G ADNXTQ
I IBETYP=2 D I IBQUIT D PAUSE^VALM1 G ADNXTQ
.S IBTDAY=1
.S IBTRTP=50
.I '$D(^IBT(356.1,"ATRTP",IBTRN,IBTRTP)) Q
.W !!,"You have already entered a Review for this Outpatient Encounter.",!,"Use Quick Edit to Edit."
.S IBQUIT=1
.Q
;
; -- inpatient review type
I IBETYP=1 S IBTRTP=15 I $D(^IBT(356.1,"ATRTP",IBTRN,15)) S IBTRTP=30
S IBRDAY=$$RDAY^IBTRV31(IBTRN)
;
INPT D REV(IBTRN,IBTRTP)
D:$G(IBSEL)'["^" EN^IBTRE3(IBTRN)
D:$G(IBSEL)'["^" EN^IBTRE4(IBTRN)
D:$G(IBSEL)'["^" EN^IBTRE5(IBTRN)
D EDIT^IBTRVD1(".21////10;.21",1)
G:$G(IBSEL)["^" ANOTHER
I IBETYP'=1 G ADNXTQ
;
ANOTHER ; -- ask if add another if no ask next review date/status
S IBMORE=$$ASKMORE^IBTRV31()
I IBMORE["^" D G ADNXTQ
.D EDIT^IBTRVD1("1.13////0;1.15////1;.2",1)
.Q
;
; -- if yes ask set next review date ="" ask status
I IBMORE D
.D EDIT^IBTRVD1(".2///@",1) ;delete next review date
.Q
; -- if no g adnxtq
I 'IBMORE S VALMBCK="R" D G ADNXTQ
.D EDIT^IBTRVD1("1.13////0;1.15;I 'X S Y=""@9"";.2//^S X=$$DAT1^IBOUTL($$NXTRVDT^IBTRV31(IBTRV));@9;1.17;S Y=""@99"";.2///@;@99",1)
;
SAME ; -- ask if same
S IBSAME=$$ASKSAME^IBTRV31()
D EDIT^IBTRVD1("1.13////1;1.14////"_+IBSAME,1)
;
I IBSAME["^" G ADNXTQ
;
; -- if yes file / increment day ask status/clinical data g another
I IBSAME D G ANOTHER
.S IBRDAY=IBRDAY+1
.S IBTRTP=30
.D MESS
.D COPY^IBTRV31(IBTRV) ; after copy ibtrv will be value of new review
.Q
;
; -- if no edit g another
I 'IBSAME D G INPT
.S IBRDAY=IBRDAY+1
.S IBTRTP=30
;
ADNXTQ Q
;
REV(IBTRN,IBTRTP) ; -- Add review
; -- input ibtrtp = tracking type code,
; ibtrn = internal id of tracking entry
I '$G(IBTRTP)!('$G(IBTRN)) W !!,"DUH, Nothing Added!" D PAUSE^VALM1 G REVQ ; only stupid programmers should get this message
N IBQUIT,IBDGPMD,IBTRVDT
S IBQUIT=0,IBTRVDT=$$RDT^IBTRV31(IBTRN)
;
I IBTRTP=30 D G:IBQUIT REVQ
.I '$D(^IBT(356.1,"ATRTP",IBTRN,15)) W !!,"There must be an admission review first" S IBQUIT=1 Q
.Q
;
; -- reviews after discharge date don't make sense
S IBDGPMD=$P($G(^DGPM(+$P(^IBT(356,IBTRN,0),"^",5),0)),"^",17)
; finish this here
;
D PRE^IBTUTL2(+$P(IBTRVDT,"."),IBTRN,IBTRTP)
D MESS
I '$D(IBTRV) G REVQ
S VA200="" D INP^VADPT
D @IBTRTP D EDIT^IBTRVD1(.DR,1)
REVQ Q
;
15 ; -- Initial edit of admission review
S DR=".03////1;D UNIT^IBTRV3(IBTRV);.01;.07////^S X=IBSPEC;.07;.23//INTERQUAL;I X'=1 S Y=""@20"";.04;.05;.06;I X=1 S Y=""@20"";12;.1;I 'X S Y=""@20"";.11;@20;11;"
Q
;
30 ; -- Initial edit for continued stay
S DR=".01;.03//^S X=$$RDAY^IBTRV31(IBTRN);D UNIT^IBTRV3(IBTRV);.07////^S X=$G(IBSPEC);.07;.23//INTERQUAL;I X'=1 S Y=""@20"";.05;.04;I $P(^IBT(356.1,DA,0),U,4),$P(^(0),U,5) S Y=""@20"";.12;13;"
S DR=DR_".1;I 'X S Y=""@20"";.11;@20;11;"
;S DR="[IBTRV NEW CONT]"
Q
;
50 ; -- outpatient review
D 15
Q
;
UNIT(X) ; -- determine if specialty is a specialized unit
; input (review)
; output 1 if unit, 0 if not
N Y,VAIN,VAINDT,VA200
S IBUNIT=0,VA200=""
I '$D(DA),$G(IBTRV) N DA S DA=IBTRV
S VAINDT=$$VDT(IBTRN,DA),VA200="" D INP^VADPT
I $P(VAIN(3),"^",2)["ICU"!$P(VAIN(3),"^",2)["CCU" S IBUNIT=1
S IBSPEC=$P(VAIN(3),U),IBPROV=$P(VAIN(2),U),IBATD=$P(VAIN(11),U)
Q
;
INSURD(X) ; -- determine if this is tracked as an ins. claim
Q +$P(^IBT(356,+$P(^IBT(356.1,X,0),"^",2),0),"^",24)
;
VDT(IBTRN,IBTRV) ; compute vaindt for day of review
N IBX,DAY
;patch 40
S IBX=$P($P(^IBT(356,+IBTRN,0),"^",6),".")_.2359 ; midnight of admission day
I $G(IBTRV) S DAY=$P($G(^IBT(356.1,+IBTRV,0)),"^",3)
I $G(DAY)>1 S IBX=$P($$FMADD^XLFDT(IBX,DAY-1),".")_.2359 ; midnight of review day (day1 = admission day) ; patch 40 corrects the time problem +.24
Q IBX
;
MESS ; -- add message
W:IBTRTP=30 !!,"Adding a Continued Stay Review for Review Day ",$G(IBRDAY),".",!
W:IBTRTP=15 !!,"Adding an Admission Review",!
W:IBTRTP=50 !!,"Adding an Outpatient Visit Review",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRV3 4625 printed Apr 09, 2024@21:27:59 Page 2
IBTRV3 ;ALB/AAS - CLAIMS TRACKING - REVIEW ACTIONS ; 14-JUL-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**40,58**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% GOTO EN^IBTRV
+1 ;
ADNXT(IBTRN) ; -- Add next Hospital Review
+1 ; -- Input ibtrn = internal entry in claims tracking (356)
+2 ;
+3 NEW IBETYP,IBTRTP,IBQUIT,IBDGPM,IBTRVDT,IBTRV,IBRDAY,IBMORE,IBSAME,IBSEL
+4 DO FULL^VALM1
+5 SET VALMBCK="R"
SET IBQUIT=0
+6 SET IBTRVDT=DT
+7 SET IBETYP=$$TRTP^IBTRE1(IBTRN)
+8 IF IBETYP>2
WRITE !!,"This doesn't appear to be an admission or outpatient visit.",!,"I don't know how to review this.",!
DO PAUSE^VALM1
GOTO ADNXTQ
+9 IF IBETYP=2
Begin DoDot:1
+10 SET IBTDAY=1
+11 SET IBTRTP=50
+12 IF '$DATA(^IBT(356.1,"ATRTP",IBTRN,IBTRTP))
QUIT
+13 WRITE !!,"You have already entered a Review for this Outpatient Encounter.",!,"Use Quick Edit to Edit."
+14 SET IBQUIT=1
+15 QUIT
End DoDot:1
IF IBQUIT
DO PAUSE^VALM1
GOTO ADNXTQ
+16 ;
+17 ; -- inpatient review type
+18 IF IBETYP=1
SET IBTRTP=15
IF $DATA(^IBT(356.1,"ATRTP",IBTRN,15))
SET IBTRTP=30
+19 SET IBRDAY=$$RDAY^IBTRV31(IBTRN)
+20 ;
INPT DO REV(IBTRN,IBTRTP)
+1 if $GET(IBSEL)'["^"
DO EN^IBTRE3(IBTRN)
+2 if $GET(IBSEL)'["^"
DO EN^IBTRE4(IBTRN)
+3 if $GET(IBSEL)'["^"
DO EN^IBTRE5(IBTRN)
+4 DO EDIT^IBTRVD1(".21////10;.21",1)
+5 if $GET(IBSEL)["^"
GOTO ANOTHER
+6 IF IBETYP'=1
GOTO ADNXTQ
+7 ;
ANOTHER ; -- ask if add another if no ask next review date/status
+1 SET IBMORE=$$ASKMORE^IBTRV31()
+2 IF IBMORE["^"
Begin DoDot:1
+3 DO EDIT^IBTRVD1("1.13////0;1.15////1;.2",1)
+4 QUIT
End DoDot:1
GOTO ADNXTQ
+5 ;
+6 ; -- if yes ask set next review date ="" ask status
+7 IF IBMORE
Begin DoDot:1
+8 ;delete next review date
DO EDIT^IBTRVD1(".2///@",1)
+9 QUIT
End DoDot:1
+10 ; -- if no g adnxtq
+11 IF 'IBMORE
SET VALMBCK="R"
Begin DoDot:1
+12 DO EDIT^IBTRVD1("1.13////0;1.15;I 'X S Y=""@9"";.2//^S X=$$DAT1^IBOUTL($$NXTRVDT^IBTRV31(IBTRV));@9;1.17;S Y=""@99"";.2///@;@99",1)
End DoDot:1
GOTO ADNXTQ
+13 ;
SAME ; -- ask if same
+1 SET IBSAME=$$ASKSAME^IBTRV31()
+2 DO EDIT^IBTRVD1("1.13////1;1.14////"_+IBSAME,1)
+3 ;
+4 IF IBSAME["^"
GOTO ADNXTQ
+5 ;
+6 ; -- if yes file / increment day ask status/clinical data g another
+7 IF IBSAME
Begin DoDot:1
+8 SET IBRDAY=IBRDAY+1
+9 SET IBTRTP=30
+10 DO MESS
+11 ; after copy ibtrv will be value of new review
DO COPY^IBTRV31(IBTRV)
+12 QUIT
End DoDot:1
GOTO ANOTHER
+13 ;
+14 ; -- if no edit g another
+15 IF 'IBSAME
Begin DoDot:1
+16 SET IBRDAY=IBRDAY+1
+17 SET IBTRTP=30
End DoDot:1
GOTO INPT
+18 ;
ADNXTQ QUIT
+1 ;
REV(IBTRN,IBTRTP) ; -- Add review
+1 ; -- input ibtrtp = tracking type code,
+2 ; ibtrn = internal id of tracking entry
+3 ; only stupid programmers should get this message
IF '$GET(IBTRTP)!('$GET(IBTRN))
WRITE !!,"DUH, Nothing Added!"
DO PAUSE^VALM1
GOTO REVQ
+4 NEW IBQUIT,IBDGPMD,IBTRVDT
+5 SET IBQUIT=0
SET IBTRVDT=$$RDT^IBTRV31(IBTRN)
+6 ;
+7 IF IBTRTP=30
Begin DoDot:1
+8 IF '$DATA(^IBT(356.1,"ATRTP",IBTRN,15))
WRITE !!,"There must be an admission review first"
SET IBQUIT=1
QUIT
+9 QUIT
End DoDot:1
if IBQUIT
GOTO REVQ
+10 ;
+11 ; -- reviews after discharge date don't make sense
+12 SET IBDGPMD=$PIECE($GET(^DGPM(+$PIECE(^IBT(356,IBTRN,0),"^",5),0)),"^",17)
+13 ; finish this here
+14 ;
+15 DO PRE^IBTUTL2(+$PIECE(IBTRVDT,"."),IBTRN,IBTRTP)
+16 DO MESS
+17 IF '$DATA(IBTRV)
GOTO REVQ
+18 SET VA200=""
DO INP^VADPT
+19 DO @IBTRTP
DO EDIT^IBTRVD1(.DR,1)
REVQ QUIT
+1 ;
15 ; -- Initial edit of admission review
+1 SET DR=".03////1;D UNIT^IBTRV3(IBTRV);.01;.07////^S X=IBSPEC;.07;.23//INTERQUAL;I X'=1 S Y=""@20"";.04;.05;.06;I X=1 S Y=""@20"";12;.1;I 'X S Y=""@20"";.11;@20;11;"
+2 QUIT
+3 ;
30 ; -- Initial edit for continued stay
+1 SET DR=".01;.03//^S X=$$RDAY^IBTRV31(IBTRN);D UNIT^IBTRV3(IBTRV);.07////^S X=$G(IBSPEC);.07;.23//INTERQUAL;I X'=1 S Y=""@20"";.05;.04;I $P(^IBT(356.1,DA,0),U,4),$P(^(0),U,5) S Y=""@20"";.12;13;"
+2 SET DR=DR_".1;I 'X S Y=""@20"";.11;@20;11;"
+3 ;S DR="[IBTRV NEW CONT]"
+4 QUIT
+5 ;
50 ; -- outpatient review
+1 DO 15
+2 QUIT
+3 ;
UNIT(X) ; -- determine if specialty is a specialized unit
+1 ; input (review)
+2 ; output 1 if unit, 0 if not
+3 NEW Y,VAIN,VAINDT,VA200
+4 SET IBUNIT=0
SET VA200=""
+5 IF '$DATA(DA)
IF $GET(IBTRV)
NEW DA
SET DA=IBTRV
+6 SET VAINDT=$$VDT(IBTRN,DA)
SET VA200=""
DO INP^VADPT
+7 IF $PIECE(VAIN(3),"^",2)["ICU"!$PIECE(VAIN(3),"^",2)["CCU"
SET IBUNIT=1
+8 SET IBSPEC=$PIECE(VAIN(3),U)
SET IBPROV=$PIECE(VAIN(2),U)
SET IBATD=$PIECE(VAIN(11),U)
+9 QUIT
+10 ;
INSURD(X) ; -- determine if this is tracked as an ins. claim
+1 QUIT +$PIECE(^IBT(356,+$PIECE(^IBT(356.1,X,0),"^",2),0),"^",24)
+2 ;
VDT(IBTRN,IBTRV) ; compute vaindt for day of review
+1 NEW IBX,DAY
+2 ;patch 40
+3 ; midnight of admission day
SET IBX=$PIECE($PIECE(^IBT(356,+IBTRN,0),"^",6),".")_.2359
+4 IF $GET(IBTRV)
SET DAY=$PIECE($GET(^IBT(356.1,+IBTRV,0)),"^",3)
+5 ; midnight of review day (day1 = admission day) ; patch 40 corrects the time problem +.24
IF $GET(DAY)>1
SET IBX=$PIECE($$FMADD^XLFDT(IBX,DAY-1),".")_.2359
+6 QUIT IBX
+7 ;
MESS ; -- add message
+1 if IBTRTP=30
WRITE !!,"Adding a Continued Stay Review for Review Day ",$GET(IBRDAY),".",!
+2 if IBTRTP=15
WRITE !!,"Adding an Admission Review",!
+3 if IBTRTP=50
WRITE !!,"Adding an Outpatient Visit Review",!
+4 QUIT
