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

IBTRE6.m

Go to the documentation of this file.
  1. IBTRE6 ;ALB/AAS - CLAIMS TRACKING OUTPUT CLIN DATA ;2-SEP-1993
  1. ;;2.0;INTEGRATED BILLING;**210,461**;21-MAR-94;Build 58
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ADMDIAG(IBTRN) ; -- output admitting diagnosis (inpatient)
  1. ;
  1. N IBRES,IBDX,X
  1. S IBRES=""
  1. I '$G(IBTRN) G ADMDQ
  1. S IBETYP=$$TRTP^IBTRE1(IBTRN) I IBETYP>1 G ADMDQ
  1. S IBDX=+$O(^IBT(356.9,"ADG",+$P(^IBT(356,+IBTRN,0),"^",5),0))
  1. I $D(VAIN(9)) S IBRES=VAIN(9) G ADMDQ
  1. N VAIN,VAINDT,VA200
  1. S VAINDT=$P($G(^IBT(356,+IBTRN,0)),U,6)
  1. S VA200="" D INP^VADPT
  1. S IBRES=VAIN(9)
  1. ADMDQ Q IBRES
  1. ;
  1. PDIAG(IBTRN) ; -- return primary diagnosis (inpatient)
  1. N IBRES,IBDX
  1. S IBRES=""
  1. I '$G(IBTRN) G PDIAGQ
  1. S IBDX=+$G(^IBT(356.9,+$O(^IBT(356.9,"ATP",+$P(^IBT(356,+IBTRN,0),"^",5),1,0)),0))
  1. S IBRES=$$DIAG(IBDX,1,$$TRNDATE^IBACSV(IBTRN))
  1. PDIAGQ Q IBRES
  1. ;
  1. SDIAG ; -- return secondary diagnosis (inpatient
  1. Q
  1. ;
  1. ODIAG ; -- return outpatient diagnosis
  1. Q
  1. ;
  1. DIAG(IBDX,IBTXT,IBDT) ; -- Expand diagnosis from pointer
  1. ; -- input IBDX = pointer to diag
  1. ; IBTXT = if want text added (zero = number only)
  1. N IBRES,IBZ
  1. I '$G(IBDX) Q ""
  1. S IBZ=$$ICD9^IBACSV(+IBDX,$G(IBDT)) I IBZ="" Q ""
  1. S IBRES=$P(IBZ,U)
  1. I $G(IBTXT) S IBRES=IBRES_" - "_$P(IBZ,U,3)
  1. Q IBRES
  1. ;
  1. ;
  1. APROV(IBTRN) ; -- return provider (inpatient)
  1. ;
  1. N X S X=""
  1. I '$G(IBTRN) G APROVQ
  1. S X=$O(^IBT(356.94,"ATP",+$P(^IBT(356,+IBTRN,0),"^",5),2,0)) I X S X=$P($G(^IBT(356.94,+X,0)),"^",3) G APROVQ
  1. S X=+$O(^IBT(356.94,"ATP",+$P(^IBT(356,+IBTRN,0),"^",5),1,0)) I X S X=$P($G(^IBT(356.94,+X,0)),"^",3) G APROVQ
  1. I $D(VAIN(2)) S X=VAIN(2) I 'X S X=$G(VAIN(11))
  1. I '$D(VAIN(2)) D
  1. .N VAIN,VAINDT
  1. .S VAINDT=$P(^IBT(356,IBTRN,0),U,6)
  1. .S VA200="" D INP^VADPT
  1. .S X=VAIN(2)
  1. .I 'X S X=VAIN(11)
  1. APROVQ Q $P($G(^VA(200,+X,0)),"^")
  1. ;
  1. ATTEND ; -- return attendings (inpatient)
  1. Q
  1. ;
  1. PROV ; -- return providers (inpatient)
  1. Q
  1. ;
  1. OPROV ; -- returns outpatient providers
  1. Q
  1. ;
  1. PROC(IBPR,IBTXT) ; -- Expand procedure from pointer
  1. ; input IBPR=proc^^date (format of ^IBT(356.91,IEN,0))
  1. ; IBTXT = if want text added (zero = number only)
  1. N IBRES,IBZ
  1. I '$G(Z) S Z=1 ; what is that?
  1. I '$G(IBPR) Q ""
  1. S IBZ=$$ICD0^IBACSV(+IBPR,$P(IBPR,U,3))
  1. S IBRES=$P(IBZ,U)
  1. I $G(IBTXT),IBZ'="" S IBRES=IBRES_" - "_$P(IBZ,U,4)
  1. Q IBRES
  1. ;
  1. ;
  1. OPROC ; -- outpatient procedures
  1. Q
  1. ;
  1. IPROC ; -- inpatient procedures
  1. Q
  1. ;
  1. LISTP(IBTRN,IBXY) ; -- return last y procedures for a tracking entry
  1. ; -- input ibtrn = tracking file pointer
  1. ; -- output array of procedure by date - ibxy(date)=procedure node
  1. ;
  1. N IBDGPM,IBDT,IBDA,IBX,IBCNT
  1. S (IBX,IBDT)="",IBXY=0
  1. I '$G(IBTRN) G LISTPQ
  1. S IBDGPM=$P($G(^IBT(356,IBTRN,0)),"^",5)
  1. Q:'IBDGPM
  1. F S IBDT=$O(^IBT(356.91,"APP",IBDGPM,IBDT)) Q:'IBDT S IBDA="" F S IBDA=$O(^IBT(356.91,"APP",IBDGPM,IBDT,IBDA)) Q:'IBDA D
  1. .S IBX(-IBDT,IBDA)=$G(^IBT(356.91,IBDA,0))
  1. ;
  1. S IBDT="" F S IBDT=$O(IBX(IBDT)) Q:'IBDT S IBDA=0 F S IBDA=$O(IBX(IBDT,IBDA)) Q:'IBDA D
  1. .S IBXY=IBXY+1
  1. .S IBXY(IBXY)=IBX(IBDT,IBDA)
  1. LISTPQ Q
  1. ;
  1. LSTPDG(X,IBDT,Y) ; -- return current diagnosis for a tracking entry
  1. ; -- input X = tracking file pointer
  1. ; ibdt = date for current diagnosis (null = last)
  1. ; y = 1= primary (default)
  1. ; 2= secondary
  1. ;
  1. N IBY,IBX S (IBY,IBX)=""
  1. I '$G(X) G LSTPDQ
  1. S:'$G(IBDT) IBDT=DT S IBDT=-(IBDT+.9)
  1. S:'$G(Y) Y=1 I Y'=1,Y'=2 S Y=1
  1. F S IBDT=$O(^IBT(356.9,"APD",X,IBDT)) Q:'IBDT!($G(IBY)) S IBDA="" F S IBDA=$O(^IBT(356.9,"APD",X,IBDT,IBDA)) Q:'IBDA!($G(IBY)) D
  1. .I $P(^IBT(356.9,IBDA,0),U,4)=Y S IBY=+^(0)
  1. LSTPDQ Q IBY
  1. ;
  1. DTCHK(DA,X) ; -- input transform for 356.94;.01. date not before admission or after discharge
  1. N IBTRN,IBOK,IBCDT
  1. S IBOK=1
  1. G:'DA!($G(X)<1) DTCHKQ
  1. S IBTRN=+$O(^IBT(356,"AD",+$P(^IBT(356.94,DA,0),"^",2),0))
  1. G:'IBTRN DTCHKQ
  1. S IBCDT=$$CDT^IBTODD1(IBTRN)
  1. I X<$P(+IBCDT,".") S IBOK=0 G DTCHKQ ;before adm
  1. I $P(IBCDT,"^",2),X>$P(IBCDT,"^",2) S IBOK=0 G DTCHKQ ; after disch
  1. I X>$$FMADD^XLFDT(DT,7) S IBOK=0 G DTCHKQ
  1. ;
  1. DTCHKQ Q IBOK
  1. ;
  1. SETSDX(IBOE,IBSDX) ; get the list of Outpatient Encounter Diagnosis
  1. ; Output: IBSDX = count Dx's found, IBSDX(count) = V POV IEN ^ Dx IEN
  1. N IBARR,IBI K IBSDX S IBSDX=0
  1. Q:'$G(IBOE)
  1. D GETDX^SDOE(+IBOE,"IBARR")
  1. S IBI=0 F S IBI=$O(IBARR(IBI)) Q:'IBI S IBSDX=IBSDX+1,IBSDX(IBSDX)=IBI_U_+IBARR(IBI)
  1. Q
  1. ;
  1. LSTSDX(IBSDX) ; Print list of Outpatient Encounter Diagnosis
  1. ; Input: IBSDX = count Dx's found, IBSDX(count) = V POV pointer ^ Dx IEN
  1. N IBI,IBDX W !
  1. S IBI=0 F S IBI=$O(IBSDX(IBI)) Q:'IBI S IBDX=$$ICD9^IBACSV(+$P(IBSDX(IBI),U,2)) I IBDX'="" W !,?2,IBI,?5,$P(IBDX,U,1),?15,$E($P(IBDX,U,3),1,55)," (ICD-",$S($P(IBDX,U,19)=1:9,1:10),")"
  1. Q
  1. ;
  1. SETSDV(IBOE,IBSDV) ; get list of Outpatient Encounter Providers
  1. ; Output: IBSDV = count of Providers found, IBSDV(count) = V PROVIDER IEN ^ DX IEN
  1. N IBARR,IBI K IBSDV S IBSDV=0
  1. Q:'$G(IBOE)
  1. D GETPRV^SDOE(+IBOE,"IBARR")
  1. S IBI=0 F S IBI=$O(IBARR(IBI)) Q:'IBI S IBSDV=IBSDV+1,IBSDV(IBSDV)=IBI_U_+IBARR(IBI)
  1. Q
  1. ;
  1. LSTSDV(IBSDV) ; Print list of Outpatient Encounter Providers
  1. ; Input: IBSDV = count of Providers found, IBSDV(count) = V PROVIDER IEN ^ PROVIDER IEN
  1. N IBI W ! S IBI=0 F S IBI=$O(IBSDV(IBI)) Q:'IBI W !,?2,IBI,?5,$P($G(^VA(200,+$P(IBSDV(IBI),U,2),0)),U)
  1. Q