- 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 Feb 19, 2025@00:28:26 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 ;