source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRV3.m@ 1553

Last change on this file since 1553 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1IBTRV3 ;ALB/AAS - CLAIMS TRACKING - REVIEW ACTIONS ; 14-JUL-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**40,58**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% G EN^IBTRV
6 ;
7ADNXT(IBTRN) ; -- Add next Hospital Review
8 ; -- Input ibtrn = internal entry in claims tracking (356)
9 ;
10 N IBETYP,IBTRTP,IBQUIT,IBDGPM,IBTRVDT,IBTRV,IBRDAY,IBMORE,IBSAME,IBSEL
11 D FULL^VALM1
12 S VALMBCK="R",IBQUIT=0
13 S IBTRVDT=DT
14 S IBETYP=$$TRTP^IBTRE1(IBTRN)
15 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
16 I IBETYP=2 D I IBQUIT D PAUSE^VALM1 G ADNXTQ
17 .S IBTDAY=1
18 .S IBTRTP=50
19 .I '$D(^IBT(356.1,"ATRTP",IBTRN,IBTRTP)) Q
20 .W !!,"You have already entered a Review for this Outpatient Encounter.",!,"Use Quick Edit to Edit."
21 .S IBQUIT=1
22 .Q
23 ;
24 ; -- inpatient review type
25 I IBETYP=1 S IBTRTP=15 I $D(^IBT(356.1,"ATRTP",IBTRN,15)) S IBTRTP=30
26 S IBRDAY=$$RDAY^IBTRV31(IBTRN)
27 ;
28INPT D REV(IBTRN,IBTRTP)
29 D:$G(IBSEL)'["^" EN^IBTRE3(IBTRN)
30 D:$G(IBSEL)'["^" EN^IBTRE4(IBTRN)
31 D:$G(IBSEL)'["^" EN^IBTRE5(IBTRN)
32 D EDIT^IBTRVD1(".21////10;.21",1)
33 G:$G(IBSEL)["^" ANOTHER
34 I IBETYP'=1 G ADNXTQ
35 ;
36ANOTHER ; -- ask if add another if no ask next review date/status
37 S IBMORE=$$ASKMORE^IBTRV31()
38 I IBMORE["^" D G ADNXTQ
39 .D EDIT^IBTRVD1("1.13////0;1.15////1;.2",1)
40 .Q
41 ;
42 ; -- if yes ask set next review date ="" ask status
43 I IBMORE D
44 .D EDIT^IBTRVD1(".2///@",1) ;delete next review date
45 .Q
46 ; -- if no g adnxtq
47 I 'IBMORE S VALMBCK="R" D G ADNXTQ
48 .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)
49 ;
50SAME ; -- ask if same
51 S IBSAME=$$ASKSAME^IBTRV31()
52 D EDIT^IBTRVD1("1.13////1;1.14////"_+IBSAME,1)
53 ;
54 I IBSAME["^" G ADNXTQ
55 ;
56 ; -- if yes file / increment day ask status/clinical data g another
57 I IBSAME D G ANOTHER
58 .S IBRDAY=IBRDAY+1
59 .S IBTRTP=30
60 .D MESS
61 .D COPY^IBTRV31(IBTRV) ; after copy ibtrv will be value of new review
62 .Q
63 ;
64 ; -- if no edit g another
65 I 'IBSAME D G INPT
66 .S IBRDAY=IBRDAY+1
67 .S IBTRTP=30
68 ;
69ADNXTQ Q
70 ;
71REV(IBTRN,IBTRTP) ; -- Add review
72 ; -- input ibtrtp = tracking type code,
73 ; ibtrn = internal id of tracking entry
74 I '$G(IBTRTP)!('$G(IBTRN)) W !!,"DUH, Nothing Added!" D PAUSE^VALM1 G REVQ ; only stupid programmers should get this message
75 N IBQUIT,IBDGPMD,IBTRVDT
76 S IBQUIT=0,IBTRVDT=$$RDT^IBTRV31(IBTRN)
77 ;
78 I IBTRTP=30 D G:IBQUIT REVQ
79 .I '$D(^IBT(356.1,"ATRTP",IBTRN,15)) W !!,"There must be an admission review first" S IBQUIT=1 Q
80 .Q
81 ;
82 ; -- reviews after discharge date don't make sense
83 S IBDGPMD=$P($G(^DGPM(+$P(^IBT(356,IBTRN,0),"^",5),0)),"^",17)
84 ; finish this here
85 ;
86 D PRE^IBTUTL2(+$P(IBTRVDT,"."),IBTRN,IBTRTP)
87 D MESS
88 I '$D(IBTRV) G REVQ
89 S VA200="" D INP^VADPT
90 D @IBTRTP D EDIT^IBTRVD1(.DR,1)
91REVQ Q
92 ;
9315 ; -- Initial edit of admission review
94 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;"
95 Q
96 ;
9730 ; -- Initial edit for continued stay
98 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;"
99 S DR=DR_".1;I 'X S Y=""@20"";.11;@20;11;"
100 ;S DR="[IBTRV NEW CONT]"
101 Q
102 ;
10350 ; -- outpatient review
104 D 15
105 Q
106 ;
107UNIT(X) ; -- determine if specialty is a specialized unit
108 ; input (review)
109 ; output 1 if unit, 0 if not
110 N Y,VAIN,VAINDT,VA200
111 S IBUNIT=0,VA200=""
112 I '$D(DA),$G(IBTRV) N DA S DA=IBTRV
113 S VAINDT=$$VDT(IBTRN,DA),VA200="" D INP^VADPT
114 I $P(VAIN(3),"^",2)["ICU"!$P(VAIN(3),"^",2)["CCU" S IBUNIT=1
115 S IBSPEC=$P(VAIN(3),U),IBPROV=$P(VAIN(2),U),IBATD=$P(VAIN(11),U)
116 Q
117 ;
118INSURD(X) ; -- determine if this is tracked as an ins. claim
119 Q +$P(^IBT(356,+$P(^IBT(356.1,X,0),"^",2),0),"^",24)
120 ;
121VDT(IBTRN,IBTRV) ; compute vaindt for day of review
122 N IBX,DAY
123 ;patch 40
124 S IBX=$P($P(^IBT(356,+IBTRN,0),"^",6),".")_.2359 ; midnight of admission day
125 I $G(IBTRV) S DAY=$P($G(^IBT(356.1,+IBTRV,0)),"^",3)
126 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
127 Q IBX
128 ;
129MESS ; -- add message
130 W:IBTRTP=30 !!,"Adding a Continued Stay Review for Review Day ",$G(IBRDAY),".",!
131 W:IBTRTP=15 !!,"Adding an Admission Review",!
132 W:IBTRTP=50 !!,"Adding an Outpatient Visit Review",!
133 Q
Note: See TracBrowser for help on using the repository browser.