| [613] | 1 | VAFCTF ;BIR/DLR-Utility for capturing patient's Date Last Treated and Event Reason ;9/9/2002
|
|---|
| 2 | ;;5.3;Registration;**428,713,766**;Aug 13, 1993;Build 3
|
|---|
| 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 | ;
|
|---|
| 9 | EN1(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
|
|---|
| 38 | ADMDIS(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 | ;
|
|---|
| 54 | ENCDT(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 | ;DG*5.3*766
|
|---|
| 74 | I $E(VAFCX3,9,10)>23 S VAFCX3=$E(VAFCX3,1,8)_"23"_$E(VAFCX3,11,14)
|
|---|
| 75 | I $E(VAFCX3,11)>5 S VAFCX3=$E(VAFCX3,1,10)_"59"_$E(VAFCX3,13,14)
|
|---|
| 76 | ;DG*5.3*713
|
|---|
| 77 | I $E(VAFCX3,13)>5 S VAFCX3=$E(VAFCX3,1,12)_"59"
|
|---|
| 78 | Q VAFCX3_"^5" ; X is either null or the date/time of the check out
|
|---|
| 79 | ;
|
|---|
