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

VAFCTF.m

Go to the documentation of this file.
  1. VAFCTF ;BIR/DLR-Utility for capturing patient's Date Last Treated and Event Reason ; 5/6/20 5:29pm
  1. ;;5.3;Registration;**428,713,766,856,1013**;Aug 13, 1993;Build 2
  1. Q ; quit if called from the top
  1. ;
  1. ;Reference to ^SCE("ADFN" supported by IA# 2953
  1. ;Reference to EXC^RGHLLOG supported by IA# 2796
  1. ;Reference to $$ICNLC^MPIF001 supported by IA #3072
  1. ;
  1. EN1(VAFCDFN,VAFCSUP) ; determine the LAST TREATMENT DATE for a single
  1. ; patient
  1. ; input: VAFCDFN - the dfn of the patient
  1. ; VAFCSUP - if 1, suppress add entries to the ADT HL7 PIVOT
  1. ; (#391.71) file for TF messaging - VAFCTFMF (optional)
  1. ; output: VAFCDATE - patient's DATE LAST TREATED
  1. ; VAFCENVR - event reason
  1. ;
  1. N ERR,VAFCSITE,VAFCLAST,VAFCSITE,VAFCADMD,VAFCENDT,VAFCDATE,VAFCENVR,VAFCTYPE,STA
  1. S U="^"
  1. S:'$D(VAFCSITE) VAFCSITE=$$KSP^XUPARAM("INST") ;defines the local facility
  1. ;**1013 - Story 1260465 (ckn) - HAC specific changes
  1. S STA=$$STA^XUAF4(VAFCSITE) I STA=741 S VAFCSITE=$$IEN^XUAF4("741MM"),STA="741MM"
  1. S (VAFCLAST,VAFCADMD)=$$ADMDIS(VAFCDFN) ; dt_"^"_event type or ""
  1. S VAFCADMD=$S(VAFCADMD]"":$P(VAFCADMD,"^"),1:"") ; event dt or null
  1. S:$P(VAFCLAST,"^",2)=3!(VAFCLAST="") VAFCENDT=$$ENCDT(VAFCDFN,VAFCADMD)
  1. ; patient has been discharged or has never been admitted. Has this
  1. ; individual been checked out of a clinic?
  1. I $D(VAFCENDT)#2,($P(VAFCLAST,U)) S VAFCLAST=$S(+VAFCENDT>+VAFCLAST:VAFCENDT,1:VAFCLAST)
  1. I $D(VAFCENDT)#2,('$P(VAFCLAST,U)) S VAFCLAST=VAFCENDT
  1. S VAFCTYPE=$P(VAFCLAST,"^",2),VAFCDATE=+VAFCLAST
  1. ; input variables to FILE^VAFCTFU
  1. ; VAFCDFN - patient ien ; VAFCSITE - treating facility
  1. ; VAFCDATE - date last treated ; VAFCENVR - event reason
  1. ;
  1. I +VAFCDATE'>0 S VAFCDATE="",VAFCENVR=""
  1. I +VAFCDATE>0 S VAFCENVR=$S(VAFCTYPE=1:"A1",VAFCTYPE=3:"A2",1:"A3") ;A1=adm;A2=dis;A3=CO
  1. N ICN S ICN=$$ICNLC^MPIF001(VAFCDFN)
  1. ;**856 adding the new parameters to this FILE^VAFCTFU call
  1. ;FILE(PDFN,FSTRG,TICN,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT,AA,IDTYP)
  1. D FILE^VAFCTFU(VAFCDFN,VAFCSITE_U_VAFCDATE_U_VAFCENVR,$G(VAFCSUP),1,.ERR,"",VAFCDFN,"A","USVHA","PI") I $D(ERR(STA)) D EXC^RGHLLOG(212,ERR(STA),VAFCDFN)
  1. ;
  1. Q
  1. ADMDIS(DFN) ; find the patient's last admission and discharge dates if
  1. ; they exist.
  1. ; Input: DFN - ien of the patient (file 2)
  1. ;Output: a valid discharge/admission date/time concatenated with
  1. ; the event type (1=admission, 3=discharge) -or- null
  1. N %,VAERR,VAIP S VAIP("D")="LAST" D IN5^VADPT
  1. I '+$G(VAIP(17,1)),('+$G(VAIP(13,1))) Q ""
  1. ; no discharge date, no admission date, return null
  1. I '+$G(VAIP(17,1)) Q $P($G(VAIP(13,1)),U)_"^1"
  1. ; no discharge date, return admission date
  1. I '+$G(VAIP(13,1)) Q $P($G(VAIP(17,1)),U)_"^3"
  1. ; no admission date, return discharge date
  1. I +$G(VAIP(17,1))>(+$G(VAIP(13,1))) Q +$G(VAIP(17,1))_"^3"
  1. ; return discharge date
  1. Q +$G(VAIP(13,1))_"^1" ; return admission date
  1. ;
  1. ENCDT(DFN,INPDT) ; find the last patient check out date/time. 'ADFN'
  1. ; cross-reference accessed through DBIA: 2953
  1. ; Input: DFN - ien of the patient (file 2)
  1. ; INPDT - date (if any) returned from the inpatient admission/
  1. ; discharge subroutine
  1. ;Output: a valid discharge/admission date/time concatenated with
  1. ; the event type (5=check out) -or- null
  1. Q:'DFN "" ; we need dfn defined
  1. N VAFCDATA,VAFCPURG,VAFCX,VAFCX1,VAFCX2,VAFCX3
  1. S VAFCX=9999999.9999999,VAFCX2=0,VAFCX3=""
  1. F S VAFCX=$O(^SCE("ADFN",DFN,VAFCX),-1) Q:'VAFCX!(INPDT>VAFCX) D Q:VAFCX2
  1. . S VAFCX1=0 F S VAFCX1=$O(^SCE("ADFN",DFN,VAFCX,VAFCX1)) Q:'VAFCX1 D Q:VAFCX2
  1. .. D GETGEN^SDOE(VAFCX1,"VAFCDATA")
  1. .. D PARSE^SDOE(.VAFCDATA,"EXTERNAL","VAFCPARS")
  1. .. I $G(VAFCPARS(.12))="CHECKED OUT" S VAFCX2=1,VAFCX3=VAFCX
  1. .. K VAFCDATA,VAFCPARS
  1. .. Q
  1. . Q
  1. K VAFCDATA,VAFCPURG,VAFCX,VAFCX1,VAFCX2
  1. ;DG*5.3*766
  1. I $E(VAFCX3,9,10)>23 S VAFCX3=$E(VAFCX3,1,8)_"23"_$E(VAFCX3,11,14)
  1. I $E(VAFCX3,11)>5 S VAFCX3=$E(VAFCX3,1,10)_"59"_$E(VAFCX3,13,14)
  1. ;DG*5.3*713
  1. I $E(VAFCX3,13)>5 S VAFCX3=$E(VAFCX3,1,12)_"59"
  1. Q VAFCX3_"^5" ; X is either null or the date/time of the check out
  1. ;