VistA-WorldVistAEHR/r/INTEGRATED_BILLING-IB-PRQ--.../IBTRV3.m

134 lines
4.4 KiB
Mathematica
Raw Normal View History

2009-11-29 13:37:14 -05:00
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