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

IBAMTV1.m

Go to the documentation of this file.
  1. IBAMTV1 ;ALB/CPM - BUILD ARRAY OF BILLABLE EPISODES ; 31-MAY-94
  1. ;;2.0;INTEGRATED BILLING;**15,33,91,132,153,293**;21-MAR-94;Build 1
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. CARE ; Build an array of episodes to be back-billed.
  1. ;
  1. ; Input: IBSTART -- First date that the patient is Means Test billable
  1. ; IBEND -- Last date that the patient is Means Test billable
  1. ; DFN -- Pointer to the patient in file #2
  1. ;
  1. ; Output: ^TMP("IBAMTV",$J,episode date) = 1^2^3, where
  1. ; 1 = adm date for inpatient care
  1. ; visit date for outpatient care
  1. ; 2 = disch/last bill date for inpatient care
  1. ; null for outpatient care
  1. ; 3 = null for inpatient care
  1. ; softlink for outpatient care
  1. ;
  1. K ^TMP("IBAMTV",$J)
  1. ;
  1. ; - inpatient at IBSTART?
  1. S VAINDT=IBSTART\1_.2359 D ADM^VADPT2
  1. I VADMVT D
  1. .S IBA=$$ORIG(VADMVT),IBADM=+$G(^DGPM(IBA,0))\1
  1. .Q:+$$MVT^DGPMOBS(IBA)
  1. .S IBDIS=+$G(^DGPM(+$P($G(^DGPM(IBA,0)),"^",17),0))\1
  1. .S:'IBDIS!(IBDIS>IBEND) IBDIS=$$FMADD^XLFDT(IBEND,1)
  1. .S ^TMP("IBAMTV",$J,IBADM)=(IBSTART\1)_"^"_IBDIS
  1. ;
  1. ; - get subsequent admissions
  1. S IBD="" F S IBD=$O(^DGPM("ATID1",DFN,IBD)) Q:'IBD!((9999999.9999999-IBD)\1'>IBSTART) S IBA=+$O(^(IBD,0)) D
  1. .S IBADM0=$G(^DGPM(IBA,0))
  1. .Q:+IBADM0>IBEND ; adm after end date for MT
  1. .Q:+$$MVT^DGPMOBS(IBA) ; adm for obs & examination
  1. .Q:$$ASIH^IBAUTL5(IBADM0) ; asih admission (catch it later)
  1. .;
  1. .S IBDIS=+$G(^DGPM(+$P($G(^DGPM(IBA,0)),"^",17),0))\1
  1. .S:'IBDIS!(IBDIS>IBEND) IBDIS=$$FMADD^XLFDT(IBEND,1)
  1. .S ^TMP("IBAMTV",$J,+IBADM0\1)=(+IBADM0\1)_"^"_IBDIS
  1. ;
  1. ; Outpatient encounters
  1. N IBVAL,IBCBK,IBFILTER,IBOE,IBOE0,IBCK,IBT,IBPB,Z
  1. S IBVAL("DFN")=DFN,IBVAL("BDT")=IBSTART,IBVAL("EDT")=IBEND
  1. ; Only parent encounters
  1. S IBFILTER=""
  1. S IBCBK="I '$P(Y0,U,6) S ^TMP(""IBOE"",$J,+$P(Y0,U,8),Y)=Y0"
  1. K ^TMP("IBOE",$J)
  1. D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1) K ^TMP("DIERR",$J)
  1. F Z=0:1:6,9,10,13 S IBCK(Z)=""
  1. S IBT=0 F S IBT=$O(^TMP("IBOE",$J,IBT)) Q:'IBT D
  1. . S IBOE=0 F S IBOE=$O(^TMP("IBOE",$J,IBT,IBOE)) Q:'IBOE S IBOE0=$G(^(IBOE)) D
  1. .. K IBPB
  1. .. I $$BILLCK^IBAMTEDU(IBOE,IBOE0,.IBCK,.IBPB) D
  1. ... S Z=$O(IBPB(0)) Q:'Z
  1. ...;
  1. ... ;Check any visits for that date for dispositions, add-edits
  1. ... I Z=3 Q:$D(^TMP("IBAMTV",$J,IBOE0\1))
  1. ... I Z=2 Q:$S($D(^TMP("IBAMTV",$J,IBOE0\1)):1,1:$$NBCSC^IBEFUNC($P(IBOE0,U,3),IBOE0\1))
  1. ...;
  1. ... S ^TMP("IBAMTV",$J,IBOE0\1)=IBOE0\1_U_U_IBOE
  1. K ^TMP("IBOE",$J)
  1. ;
  1. K IBA,IBADM,IBADM0,IBAD,IBD,IBDIS,IBDT,IBI,VAINDT,VADMVT
  1. ;
  1. Q
  1. ;
  1. INP(DATE) ; Was the patient an inpatient on DATE?
  1. ; Input: DATE -- Date of outpatient visit
  1. ; array IBARR
  1. ; Output: 1 -- Patient was an inpatient on DATE
  1. ; 0 -- Patient was not
  1. N X,Y,Z S X=0
  1. I '$G(DATE) G INPQ
  1. S Y=0 F S Y=$O(IBARR(Y)) Q:X!'Y!(Y>DATE) D
  1. .S Z=0 F S Z=$O(IBARR(Y,Z)) Q:'Z S Z1=$G(IBARR(Y,Z)) I DATE'<+Z1,DATE'>$P(Z1,"^",2) S X=1 Q
  1. INPQ Q X
  1. ;
  1. ORIG(IBA) ; Find first admission pointer, considering ASIH movements
  1. ; Input: IBA -- Pointer to admission in #405
  1. ; Output: Z -- Pointer to original admission in #405
  1. N X,Y,Z S Z=+$G(IBA)
  1. F S X=$G(^DGPM(Z,0)),Z=$P(X,"^",14),Y=$P(X,"^",21) Q:Y="" S Z=Y
  1. Q Z