Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCTF.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCTF.m
r613 r623 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 ; 1 VAFCTF ;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 ; 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 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 TracChangeset
for help on using the changeset viewer.
