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

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

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1IBAMTV1 ;ALB/CPM - BUILD ARRAY OF BILLABLE EPISODES ; 31-MAY-94
2 ;;2.0;INTEGRATED BILLING;**15,33,91,132,153,293**;21-MAR-94;Build 1
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CARE ; Build an array of episodes to be back-billed.
6 ;
7 ; Input: IBSTART -- First date that the patient is Means Test billable
8 ; IBEND -- Last date that the patient is Means Test billable
9 ; DFN -- Pointer to the patient in file #2
10 ;
11 ; Output: ^TMP("IBAMTV",$J,episode date) = 1^2^3, where
12 ; 1 = adm date for inpatient care
13 ; visit date for outpatient care
14 ; 2 = disch/last bill date for inpatient care
15 ; null for outpatient care
16 ; 3 = null for inpatient care
17 ; softlink for outpatient care
18 ;
19 K ^TMP("IBAMTV",$J)
20 ;
21 ; - inpatient at IBSTART?
22 S VAINDT=IBSTART\1_.2359 D ADM^VADPT2
23 I VADMVT D
24 .S IBA=$$ORIG(VADMVT),IBADM=+$G(^DGPM(IBA,0))\1
25 .Q:+$$MVT^DGPMOBS(IBA)
26 .S IBDIS=+$G(^DGPM(+$P($G(^DGPM(IBA,0)),"^",17),0))\1
27 .S:'IBDIS!(IBDIS>IBEND) IBDIS=$$FMADD^XLFDT(IBEND,1)
28 .S ^TMP("IBAMTV",$J,IBADM)=(IBSTART\1)_"^"_IBDIS
29 ;
30 ; - get subsequent admissions
31 S IBD="" F S IBD=$O(^DGPM("ATID1",DFN,IBD)) Q:'IBD!((9999999.9999999-IBD)\1'>IBSTART) S IBA=+$O(^(IBD,0)) D
32 .S IBADM0=$G(^DGPM(IBA,0))
33 .Q:+IBADM0>IBEND ; adm after end date for MT
34 .Q:+$$MVT^DGPMOBS(IBA) ; adm for obs & examination
35 .Q:$$ASIH^IBAUTL5(IBADM0) ; asih admission (catch it later)
36 .;
37 .S IBDIS=+$G(^DGPM(+$P($G(^DGPM(IBA,0)),"^",17),0))\1
38 .S:'IBDIS!(IBDIS>IBEND) IBDIS=$$FMADD^XLFDT(IBEND,1)
39 .S ^TMP("IBAMTV",$J,+IBADM0\1)=(+IBADM0\1)_"^"_IBDIS
40 ;
41 ; Outpatient encounters
42 N IBVAL,IBCBK,IBFILTER,IBOE,IBOE0,IBCK,IBT,IBPB,Z
43 S IBVAL("DFN")=DFN,IBVAL("BDT")=IBSTART,IBVAL("EDT")=IBEND
44 ; Only parent encounters
45 S IBFILTER=""
46 S IBCBK="I '$P(Y0,U,6) S ^TMP(""IBOE"",$J,+$P(Y0,U,8),Y)=Y0"
47 K ^TMP("IBOE",$J)
48 D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1) K ^TMP("DIERR",$J)
49 F Z=0:1:6,9,10,13 S IBCK(Z)=""
50 S IBT=0 F S IBT=$O(^TMP("IBOE",$J,IBT)) Q:'IBT D
51 . S IBOE=0 F S IBOE=$O(^TMP("IBOE",$J,IBT,IBOE)) Q:'IBOE S IBOE0=$G(^(IBOE)) D
52 .. K IBPB
53 .. I $$BILLCK^IBAMTEDU(IBOE,IBOE0,.IBCK,.IBPB) D
54 ... S Z=$O(IBPB(0)) Q:'Z
55 ...;
56 ... ;Check any visits for that date for dispositions, add-edits
57 ... I Z=3 Q:$D(^TMP("IBAMTV",$J,IBOE0\1))
58 ... I Z=2 Q:$S($D(^TMP("IBAMTV",$J,IBOE0\1)):1,1:$$NBCSC^IBEFUNC($P(IBOE0,U,3),IBOE0\1))
59 ...;
60 ... S ^TMP("IBAMTV",$J,IBOE0\1)=IBOE0\1_U_U_IBOE
61 K ^TMP("IBOE",$J)
62 ;
63 K IBA,IBADM,IBADM0,IBAD,IBD,IBDIS,IBDT,IBI,VAINDT,VADMVT
64 ;
65 Q
66 ;
67INP(DATE) ; Was the patient an inpatient on DATE?
68 ; Input: DATE -- Date of outpatient visit
69 ; array IBARR
70 ; Output: 1 -- Patient was an inpatient on DATE
71 ; 0 -- Patient was not
72 N X,Y,Z S X=0
73 I '$G(DATE) G INPQ
74 S Y=0 F S Y=$O(IBARR(Y)) Q:X!'Y!(Y>DATE) D
75 .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
76INPQ Q X
77 ;
78ORIG(IBA) ; Find first admission pointer, considering ASIH movements
79 ; Input: IBA -- Pointer to admission in #405
80 ; Output: Z -- Pointer to original admission in #405
81 N X,Y,Z S Z=+$G(IBA)
82 F S X=$G(^DGPM(Z,0)),Z=$P(X,"^",14),Y=$P(X,"^",21) Q:Y="" S Z=Y
83 Q Z
Note: See TracBrowser for help on using the repository browser.