source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCTF.m@ 691

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

revised back to 6/30/08 version
File size: 3.5 KB
Line 
1VAFCTF ;BIR/DLR-Utility for capturing patient's Date Last Treated and Event Reason ;9/9/2002
2 ;;5.3;Registration;**428,713**;Aug 13, 1993
3 Q ; quit if called from the top
4 ;
5 ;Reference to ^SCE("ADFN" supported by IA# 2953
6 ;Reference to EXC^RGHLLOG supported by IA# 2796
7 ;Reference to $$ICNLC^MPIF001 supported by IA #3072
8 ;
9EN1(VAFCDFN,VAFCSUP) ; determine the LAST TREATMENT DATE for a single
10 ; patient
11 ; input: VAFCDFN - the dfn of the patient
12 ; VAFCSUP - if 1, suppress add entries to the ADT HL7 PIVOT
13 ; (#391.71) file for TF messaging - VAFCTFMF (optional)
14 ; output: VAFCDATE - patient's DATE LAST TREATED
15 ; VAFCENVR - event reason
16 ;
17 N ERR,VAFCSITE,VAFCLAST,VAFCSITE,VAFCADMD,VAFCENDT,VAFCDATE,VAFCENVR,VAFCTYPE
18 S U="^"
19 S:'$D(VAFCSITE) VAFCSITE=$$KSP^XUPARAM("INST") ;defines the local facility
20 S (VAFCLAST,VAFCADMD)=$$ADMDIS(VAFCDFN) ; dt_"^"_event type or ""
21 S VAFCADMD=$S(VAFCADMD]"":$P(VAFCADMD,"^"),1:"") ; event dt or null
22 S:$P(VAFCLAST,"^",2)=3!(VAFCLAST="") VAFCENDT=$$ENCDT(VAFCDFN,VAFCADMD)
23 ; patient has been discharged or has never been admitted. Has this
24 ; individual been checked out of a clinic?
25 I $D(VAFCENDT)#2,($P(VAFCLAST,U)) S VAFCLAST=$S(+VAFCENDT>+VAFCLAST:VAFCENDT,1:VAFCLAST)
26 I $D(VAFCENDT)#2,('$P(VAFCLAST,U)) S VAFCLAST=VAFCENDT
27 S VAFCTYPE=$P(VAFCLAST,"^",2),VAFCDATE=+VAFCLAST
28 ; input variables to FILE^VAFCTFU
29 ; VAFCDFN - patient ien ; VAFCSITE - treating facility
30 ; VAFCDATE - date last treated ; VAFCENVR - event reason
31 ;
32 I +VAFCDATE'>0 S VAFCDATE="",VAFCENVR=""
33 I +VAFCDATE>0 S VAFCENVR=$S(VAFCTYPE=1:"A1",VAFCTYPE=3:"A2",1:"A3") ;A1=adm;A2=dis;A3=CO
34 N STA,ICN S ICN=$$ICNLC^MPIF001(VAFCDFN),STA=$P($$SITE^VASITE,"^",3)
35 D FILE^VAFCTFU(VAFCDFN,VAFCSITE_U_VAFCDATE_U_VAFCENVR,$G(VAFCSUP),1,.ERR) I $D(ERR(STA)) D EXC^RGHLLOG(212,ERR(STA),VAFCDFN)
36 ;
37 Q
38ADMDIS(DFN) ; find the patient's last admission and discharge dates if
39 ; they exist.
40 ; Input: DFN - ien of the patient (file 2)
41 ;Output: a valid discharge/admission date/time concatenated with
42 ; the event type (1=admission, 3=discharge) -or- null
43 N %,VAERR,VAIP S VAIP("D")="LAST" D IN5^VADPT
44 I '+$G(VAIP(17,1)),('+$G(VAIP(13,1))) Q ""
45 ; no discharge date, no admission date, return null
46 I '+$G(VAIP(17,1)) Q $P($G(VAIP(13,1)),U)_"^1"
47 ; no discharge date, return admission date
48 I '+$G(VAIP(13,1)) Q $P($G(VAIP(17,1)),U)_"^3"
49 ; no admission date, return discharge date
50 I +$G(VAIP(17,1))>(+$G(VAIP(13,1))) Q +$G(VAIP(17,1))_"^3"
51 ; return discharge date
52 Q +$G(VAIP(13,1))_"^1" ; return admission date
53 ;
54ENCDT(DFN,INPDT) ; find the last patient check out date/time. 'ADFN'
55 ; cross-reference accessed through DBIA: 2953
56 ; Input: DFN - ien of the patient (file 2)
57 ; INPDT - date (if any) returned from the inpatient admission/
58 ; discharge subroutine
59 ;Output: a valid discharge/admission date/time concatenated with
60 ; the event type (5=check out) -or- null
61 Q:'DFN "" ; we need dfn defined
62 N VAFCDATA,VAFCPURG,VAFCX,VAFCX1,VAFCX2,VAFCX3
63 S VAFCX=9999999.9999999,VAFCX2=0,VAFCX3=""
64 F S VAFCX=$O(^SCE("ADFN",DFN,VAFCX),-1) Q:'VAFCX!(INPDT>VAFCX) D Q:VAFCX2
65 . S VAFCX1=0 F S VAFCX1=$O(^SCE("ADFN",DFN,VAFCX,VAFCX1)) Q:'VAFCX1 D Q:VAFCX2
66 .. D GETGEN^SDOE(VAFCX1,"VAFCDATA")
67 .. D PARSE^SDOE(.VAFCDATA,"EXTERNAL","VAFCPARS")
68 .. I $G(VAFCPARS(.12))="CHECKED OUT" S VAFCX2=1,VAFCX3=VAFCX
69 .. K VAFCDATA,VAFCPARS
70 .. Q
71 . Q
72 K VAFCDATA,VAFCPURG,VAFCX,VAFCX1,VAFCX2
73 I $E(VAFCX3,13)>5 S VAFCX3=$E(VAFCX3,1,12)_"59"
74 Q VAFCX3_"^5" ; X is either null or the date/time of the check out
75 ;
Note: See TracBrowser for help on using the repository browser.