1 | IVMUFNC1 ;ALB/SEK - INPATIENT/OUTPATIENT CALCULATIONS ; 06/19/2003
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH ;**3,11,80**; 21-OCT-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | EN(DFN,IVMMTDT,IVMQUERY) ; number of inpatient and outpatient days since IVMMTDT date to
|
---|
6 | ; IVMENDT (earliest of day before next means test and day before current date).
|
---|
7 | ; Input: DFN -- pointer to patient in file #2
|
---|
8 | ; IVMMTDT -- Means Test date/time for the patient
|
---|
9 | ; IVMQUERY("OVIS") -- # of the QUERY that is currently open or
|
---|
10 | ; undefined, zero, or null if no QUERY opened for
|
---|
11 | ; finding outpatient visits
|
---|
12 | ; Output: 1^2 where piece 1 = # of inpatient days
|
---|
13 | ; piece 2 = # of outpatient days
|
---|
14 | ;
|
---|
15 | N IVMAD,IVMADMDT,IVMD,IVMDCN,IVMDT,IVMDGPM,IVMDISDT,IVMENDT,IVMF,IVMI,IVMIN,IVMOUT
|
---|
16 | N IVMASIH,IVMADPTR,IVMDATE,VAINDT,VADMVT,VAIP,VAERR
|
---|
17 | ;
|
---|
18 | S (IVMIN,IVMOUT)=0
|
---|
19 | I '$G(IVMMTDT) G EPQ
|
---|
20 | S IVMMTDT=$P($$LST^DGMTU(DFN,IVMMTDT),"^",2)
|
---|
21 | I '$G(IVMMTDT) G EPQ
|
---|
22 | S IVMMTDT=$P(IVMMTDT,".")
|
---|
23 | K ^TMP($J,"IVMUFNC1")
|
---|
24 | ;
|
---|
25 | ; - quit if the effective date of the test is today
|
---|
26 | I IVMMTDT=DT G EPQ
|
---|
27 | ;
|
---|
28 | ; Calculate number of inpatient days
|
---|
29 | ;
|
---|
30 | ; get end date
|
---|
31 | S IVMENDT=$$END^IVMUFNC2(DFN,IVMMTDT)
|
---|
32 | ;
|
---|
33 | ; - find if patient was an inpatient on IVMMTDT
|
---|
34 | S VAINDT=IVMMTDT D ADM^VADPT2
|
---|
35 | I VADMVT S IVMASIH=$P($G(^DGPM(VADMVT,0)),"^",21) D
|
---|
36 | .I IVMASIH D Q
|
---|
37 | ..S IVMIN=IVMIN+$$LOS(VADMVT,IVMMTDT)
|
---|
38 | ..S IVMADPTR=$P($G(^DGPM(IVMASIH,0)),"^",14)
|
---|
39 | ..S IVMDATE=$$CHK(IVMADPTR,IVMMTDT)
|
---|
40 | ..S IVMIN=IVMIN+$$LOS(IVMADPTR,IVMDATE)
|
---|
41 | .S VAIP("D")=IVMMTDT D IN5^VADPT
|
---|
42 | .I 'VAIP(10) S IVMDATE=$$CHK(VADMVT,IVMMTDT)
|
---|
43 | .S IVMIN=IVMIN+$$LOS(VADMVT,$S('VAIP(10):IVMDATE,1:IVMMTDT))
|
---|
44 | ;
|
---|
45 | ; - find admissions after IVMMTDT to end date
|
---|
46 | S IVMD="" F S IVMD=$O(^DGPM("ATID1",DFN,IVMD)) Q:'IVMD!(9999999.9999999-IVMD<IVMMTDT) I 9999999.9999999-IVMD'>IVMENDT S IVMIN=IVMIN+$$LOS(+$O(^(IVMD,0)))
|
---|
47 | ;
|
---|
48 | ; Calculate number of outpatient days
|
---|
49 | ;
|
---|
50 | D EN^IVMUFNC2(.IVMQUERY)
|
---|
51 | ;
|
---|
52 | EPQ K ^TMP($J,"IVMUFNC1")
|
---|
53 | Q IVMIN_"^"_IVMOUT
|
---|
54 | ;
|
---|
55 | ;
|
---|
56 | LOS(IVMDG,IVMST) ; Calculate the length of stay for an admission.
|
---|
57 | ; Input: IVMDG -- Pointer to the admission in file #405
|
---|
58 | ; IVMST -- [Optional] Date after the admission on
|
---|
59 | ; which to begin calculation of the LOS.
|
---|
60 | ; Output: X -- Length of stay (in days)
|
---|
61 | ;
|
---|
62 | N A,D,DFN,DGE,DGS,I,X,X1,X2,LOP,LOA,LOAS,LOS
|
---|
63 | S (LOP,LOA,LOAS)=0
|
---|
64 | I $S('$D(IVMDG):1,'$D(^DGPM(+IVMDG,0)):1,$P(^(0),"^",2)'=1:1,1:0) S X=0 G Q
|
---|
65 | S X=^DGPM(+IVMDG,0),DFN=$P(^(0),"^",3),(X2,A)=+X,D=$S($D(^DGPM(+$P(X,"^",17),0)):+^(0),1:""),(X1,D)=$S('D:IVMENDT,D>IVMENDT:IVMENDT,1:D)
|
---|
66 | I $G(IVMST)'<$P(D,".") S X=0 G Q
|
---|
67 | S:$G(IVMST) (X2,A)=IVMST
|
---|
68 | D ^%DTC S LOS=$S(X:X,1:1) ; LOS = elapsed time between admission and discharge (or end date)
|
---|
69 | F I=A:0 S I=$O(^DGPM("APCA",DFN,IVMDG,I)) Q:'I S DGS=$O(^(I,0)) I $D(^DGPM(+DGS,0)) S DGS=^(0) Q:+DGS>IVMENDT I "^1^2^3^13^43^44^45^"[("^"_$P(DGS,"^",18)_"^") S X2=+DGS,DGS=$P(DGS,"^",18) D ABS Q:'I
|
---|
70 | S X=LOS-LOA-LOAS
|
---|
71 | Q Q X
|
---|
72 | ;
|
---|
73 | ABS ; If patient was out on absence, find return
|
---|
74 | S X1=0 F I=I:0 S I=$O(^DGPM("APCA",DFN,IVMDG,I)) Q:'I S DGE=$O(^(I,0)) I $D(^DGPM(+DGE,0)) S DGE=^(0) I "^14^22^23^24^"[("^"_$P(DGE,"^",18)_"^") S X1=+DGE,DGE=$P(DGE,"^",18) Q
|
---|
75 | ; if no return from absence, use discharge or end date
|
---|
76 | ; if return from absence greater then end date use end date
|
---|
77 | I 'X1!(X1>D) S X1=D
|
---|
78 | D ^%DTC S X=$S(X:X,1:1) I DGS=1,$S('$D(DGE):1,DGE'=25:1,1:0) S LOP=LOP+X Q ;if TO AA <96, but not FROM AA<96, count as absence, not pass
|
---|
79 | I "^1^2^3^25^26^"[("^"_DGS_"^") S LOA=LOA+X Q
|
---|
80 | S LOAS=LOAS+X Q
|
---|
81 | ;
|
---|
82 | CHK(ADPTR,DATE) ; Determine date that patient returned from leave
|
---|
83 | ; Input: ADPTR -- Pointer to admission in file #405
|
---|
84 | ; DATE -- Date the patient was on leave or ASIH
|
---|
85 | ; Output: X1 -- Date the patient returned from leave
|
---|
86 | N X,Y,I,%,X1,X2,DIS,DGE
|
---|
87 | S X=^DGPM(+ADPTR,0),DIS=$S($D(^DGPM(+$P(X,"^",17),0)):+^(0),1:""),DIS=$S('DIS:IVMENDT,DIS>IVMENDT:IVMENDT,1:DIS)
|
---|
88 | S X1=0 F I=DATE:0 S I=$O(^DGPM("APCA",DFN,ADPTR,I)) Q:'I S DGE=$O(^(I,0)) I $D(^DGPM(+DGE,0)) S DGE=^(0) I "^14^22^23^24^"[("^"_$P(DGE,"^",18)_"^") S X1=+DGE Q
|
---|
89 | Q $P($S(X1:X1,1:DIS),".")
|
---|