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