Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTRV3

IBTRV3.m

Go to the documentation of this file. 
  1. IBTRV3 ;ALB/AAS - CLAIMS TRACKING -  REVIEW ACTIONS ; 14-JUL-93
  1.  ;;Version 2.0 ; INTEGRATED BILLING ;**40,58**; 21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. % G EN^IBTRV
  1.  ;
  1. ADNXT(IBTRN) ; -- Add next Hospital Review
  1.  ; -- Input  ibtrn = internal entry in claims tracking (356)
  1.  ;
  1.  N IBETYP,IBTRTP,IBQUIT,IBDGPM,IBTRVDT,IBTRV,IBRDAY,IBMORE,IBSAME,IBSEL
  1.  D FULL^VALM1
  1.  S VALMBCK="R",IBQUIT=0
  1.  S IBTRVDT=DT
  1.  S IBETYP=$$TRTP^IBTRE1(IBTRN)
  1.  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
  1.  I IBETYP=2 D  I IBQUIT D PAUSE^VALM1 G ADNXTQ
  1.  .S IBTDAY=1
  1.  .S IBTRTP=50
  1.  .I '$D(^IBT(356.1,"ATRTP",IBTRN,IBTRTP)) Q
  1.  .W !!,"You have already entered a Review for this Outpatient Encounter.",!,"Use Quick Edit to Edit."
  1.  .S IBQUIT=1
  1.  .Q
  1.  ;
  1.  ; -- inpatient review type
  1.  I IBETYP=1 S IBTRTP=15 I $D(^IBT(356.1,"ATRTP",IBTRN,15)) S IBTRTP=30
  1.  S IBRDAY=$$RDAY^IBTRV31(IBTRN)
  1.  ;
  1. INPT D REV(IBTRN,IBTRTP)
  1.  D:$G(IBSEL)'["^" EN^IBTRE3(IBTRN)
  1.  D:$G(IBSEL)'["^" EN^IBTRE4(IBTRN)
  1.  D:$G(IBSEL)'["^" EN^IBTRE5(IBTRN)
  1.  D EDIT^IBTRVD1(".21////10;.21",1)
  1.  G:$G(IBSEL)["^" ANOTHER
  1.  I IBETYP'=1 G ADNXTQ
  1.  ;
  1. ANOTHER ; -- ask if add another if no ask next review date/status
  1.  S IBMORE=$$ASKMORE^IBTRV31()
  1.  I IBMORE["^" D  G ADNXTQ
  1.  .D EDIT^IBTRVD1("1.13////0;1.15////1;.2",1)
  1.  .Q
  1.  ;
  1.  ; -- if yes ask set next review date ="" ask status
  1.  I IBMORE D
  1.  .D EDIT^IBTRVD1(".2///@",1) ;delete next review date
  1.  .Q
  1.  ; -- if no g adnxtq
  1.  I 'IBMORE S VALMBCK="R" D  G ADNXTQ
  1.  .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)
  1.  ;
  1. SAME ; -- ask if same
  1.  S IBSAME=$$ASKSAME^IBTRV31()
  1.  D EDIT^IBTRVD1("1.13////1;1.14////"_+IBSAME,1)
  1.  ;
  1.  I IBSAME["^" G ADNXTQ
  1.  ;
  1.  ; -- if yes file / increment day ask status/clinical data g another
  1.  I IBSAME D  G ANOTHER
  1.  .S IBRDAY=IBRDAY+1
  1.  .S IBTRTP=30
  1.  .D MESS
  1.  .D COPY^IBTRV31(IBTRV) ; after copy ibtrv will be value of new review
  1.  .Q
  1.  ;
  1.  ; -- if no edit g another
  1.  I 'IBSAME D  G INPT
  1.  .S IBRDAY=IBRDAY+1
  1.  .S IBTRTP=30
  1.  ;
  1. ADNXTQ Q
  1.  ;
  1. REV(IBTRN,IBTRTP) ; -- Add review
  1.  ; -- input ibtrtp = tracking type code,
  1.  ;          ibtrn  = internal id of tracking entry
  1.  I '$G(IBTRTP)!('$G(IBTRN)) W !!,"DUH, Nothing Added!" D PAUSE^VALM1 G REVQ ; only stupid programmers should get this message
  1.  N IBQUIT,IBDGPMD,IBTRVDT
  1.  S IBQUIT=0,IBTRVDT=$$RDT^IBTRV31(IBTRN)
  1.  ;
  1.  I IBTRTP=30 D  G:IBQUIT REVQ
  1.  .I '$D(^IBT(356.1,"ATRTP",IBTRN,15)) W !!,"There must be an admission review first" S IBQUIT=1 Q
  1.  .Q
  1.  ;
  1.  ; -- reviews after discharge date don't make sense
  1.  S IBDGPMD=$P($G(^DGPM(+$P(^IBT(356,IBTRN,0),"^",5),0)),"^",17)
  1.  ; finish this here
  1.  ;
  1.  D PRE^IBTUTL2(+$P(IBTRVDT,"."),IBTRN,IBTRTP)
  1.  D MESS
  1.  I '$D(IBTRV) G REVQ
  1.  S VA200="" D INP^VADPT
  1.  D @IBTRTP D EDIT^IBTRVD1(.DR,1)
  1. REVQ Q
  1.  ;
  1. 15 ; -- Initial edit of admission review
  1.  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;"
  1.  Q
  1.  ;
  1. 30 ; -- Initial edit for continued stay
  1.  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;"
  1.  S DR=DR_".1;I 'X S Y=""@20"";.11;@20;11;"
  1.  ;S DR="[IBTRV NEW CONT]"
  1.  Q
  1.  ;
  1. 50 ; -- outpatient review
  1.  D 15
  1.  Q
  1.  ;
  1. UNIT(X) ; -- determine if specialty is a specialized unit
  1.  ;    input (review)
  1.  ;    output 1 if unit, 0 if not
  1.  N Y,VAIN,VAINDT,VA200
  1.  S IBUNIT=0,VA200=""
  1.  I '$D(DA),$G(IBTRV) N DA S DA=IBTRV
  1.  S VAINDT=$$VDT(IBTRN,DA),VA200="" D INP^VADPT
  1.  I $P(VAIN(3),"^",2)["ICU"!$P(VAIN(3),"^",2)["CCU" S IBUNIT=1
  1.  S IBSPEC=$P(VAIN(3),U),IBPROV=$P(VAIN(2),U),IBATD=$P(VAIN(11),U)
  1.  Q
  1.  ;
  1. INSURD(X) ; -- determine if this is tracked as an ins. claim
  1.  Q +$P(^IBT(356,+$P(^IBT(356.1,X,0),"^",2),0),"^",24)
  1.  ;
  1. VDT(IBTRN,IBTRV) ; compute vaindt for day of review
  1.  N IBX,DAY
  1.  ;patch 40
  1.  S IBX=$P($P(^IBT(356,+IBTRN,0),"^",6),".")_.2359 ; midnight of admission day
  1.  I $G(IBTRV) S DAY=$P($G(^IBT(356.1,+IBTRV,0)),"^",3)
  1.  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
  1.  Q IBX
  1.  ;
  1. MESS ; -- add message
  1.  W:IBTRTP=30 !!,"Adding a Continued Stay Review for Review Day ",$G(IBRDAY),".",!
  1.  W:IBTRTP=15 !!,"Adding an Admission Review",!
  1.  W:IBTRTP=50 !!,"Adding an Outpatient Visit Review",!
  1.  Q