MMRSIPC2 ;MIA/LMT - Print MRSA IPEC Report Cont. (Contains functions to collect patient movements) ;02/15/17 10:35
;;1.0;MRSA PROGRAM TOOLS;**1,5**;Mar 22, 2009;Build 146
;
; Reference to ^DGPM("ATT"_X supported by ICR #1865
; Reference to ^DGPM("APTT"_X supported by ICR #2090
; Reference to ^DGPM(D0,0) supported by ICR #419
; Reference to ^DGPM("AMV"_X supported by ICR #419
; Reference to ^DPT("CN", supported by ICR #5431
;
;
GETMOVE ;Collects ward movements for patients that were admitted or discharged in date range.
;
; ZEXCEPT: BYADM,MMRSLOC
;
N LOC,DUPLOC,MMRSLOC2
;
S LOC=0 F S LOC=$O(MMRSLOC(LOC)) Q:'LOC D
. S DUPLOC=$$DUPLOC(LOC,.MMRSLOC)
. I 'DUPLOC S MMRSLOC2(LOC)=""
. I DUPLOC D
. . I BYADM D GETADM(LOC)
. . I 'BYADM D GETDIS(LOC)
. . I 'BYADM D GETNODIS(LOC) ;For discharge\transmission report show list of patients that have not been discharged yet
I '$D(MMRSLOC2) Q
I BYADM D GETADM(0)
I 'BYADM D GETDIS(0)
I 'BYADM D GETNODIS(0) ;For discharge\transmission report show list of patients that have not been discharged yet
;
Q
;
GETADM(LOC) ;
;
; ZEXCEPT: MMRSLOC2,STRTDT
;
N TT,MOVDT,MOVIFN,DFN,TRANTYPE,INWARD,INDATE,INIFN,INTT,OUTDATE,OUTIFN,OUTTT,NEXTIEN,LOCNAME,VAIP,INLOC
N OUTWARD,PREVWARD
;
F TT=1,2 S MOVDT=STRTDT-.0000001 F S MOVDT=$O(^DGPM("ATT"_TT,MOVDT)) Q:(MOVDT>ENDDT)!('MOVDT) D
. S MOVIFN="" F S MOVIFN=$O(^DGPM("ATT"_TT,MOVDT,MOVIFN)) Q:'MOVIFN D
. . D KVA^VADPT S DFN=$P($G(^DGPM(MOVIFN,0)),"^",3),VAIP("E")=MOVIFN D IN5^VADPT
. . S TRANTYPE=$$TRANTYPE(+VAIP(4),+VAIP(2),VAIP(1),DFN)
. . S PREVWARD=$P(TRANTYPE,U,2)
. . S TRANTYPE=$P(TRANTYPE,U,1)
. . I TRANTYPE<1!(TRANTYPE=3) Q
. . S INWARD=+VAIP(5)
. . I PREVWARD="" S PREVWARD=+VAIP(15,4)
. . I TRANTYPE=2,'$$CNGWARD(LOC,PREVWARD,INWARD) Q
. . Q:$$EXCWARD(LOC,INWARD)
. . ;SET GLOBAL
. . S INDATE=+VAIP(3)
. . S INIFN=MOVIFN
. . S INTT=TRANTYPE
. . ;
. . S (OUTDATE,OUTIFN,OUTTT)=" "
. . F Q:(VAIP(16)="")!(OUTIFN) D
. . . S TRANTYPE=$$TRANTYPE(+VAIP(16,3),+VAIP(16,2),VAIP(16),DFN)
. . . S OUTWARD=$P(TRANTYPE,U,2)
. . . S NEXTIEN=$P(TRANTYPE,U,3)
. . . S TRANTYPE=$P(TRANTYPE,U,1)
. . . I OUTWARD="" S OUTWARD=+VAIP(16,4)
. . . I TRANTYPE=3 S OUTDATE=+VAIP(16,1),OUTIFN=VAIP(16),OUTTT=3
. . . I TRANTYPE=2,$$CNGWARD(LOC,INWARD,OUTWARD) S OUTDATE=+VAIP(16,1),OUTIFN=VAIP(16),OUTTT=2
. . . Q:OUTIFN
. . . I NEXTIEN="" S NEXTIEN=VAIP(16)
. . . D KVA^VADPT
. . . S VAIP("E")=NEXTIEN
. . . D IN5^VADPT
. . ;
. . S INLOC=$G(LOC)
. . I +INLOC=0 S INLOC=$$GETLOC(INWARD,.MMRSLOC2)
. . S LOCNAME=$P($G(^MMRS(104.3,INLOC,0)),U)
. . S ^TMP($J,"MMRSIPC","D",LOCNAME,INDATE,DFN,OUTDATE)=INLOC_U_DFN_U_INDATE_U_INIFN_U_INTT_U_OUTDATE_U_OUTIFN_U_OUTTT
;
D KVA^VADPT
;
Q
;
GETDIS(LOC) ;
;
; ZEXCEPT: MMRSLOC2,STRTDT
;
N TT,MOVDT,MOVIFN,DFN,TRANTYPE,OUTDATE,OUTIFN,OUTTT,INWARD,INDATE,INIFN,INTT,PREVIEN,INLOC,LOCNAME,VAIP
N NEXTWARD,PREVWARD
;
F TT=2,3 S MOVDT=STRTDT-.0000001 F S MOVDT=$O(^DGPM("ATT"_TT,MOVDT)) Q:(MOVDT>ENDDT)!('MOVDT) D
. S MOVIFN="" F S MOVIFN=$O(^DGPM("ATT"_TT,MOVDT,MOVIFN)) Q:'MOVIFN D
. . D KVA^VADPT S DFN=$P($G(^DGPM(MOVIFN,0)),"^",3),VAIP("E")=MOVIFN D IN5^VADPT
. . I +VAIP(2)=3,+VAIP(15,3)=2 Q ;Ignore discharges that are immediate following an Authorized Absence
. . S TRANTYPE=$$TRANTYPE(+VAIP(4),+VAIP(2),VAIP(1),DFN)
. . S NEXTWARD=$P(TRANTYPE,U,2)
. . S TRANTYPE=$P(TRANTYPE,U,1)
. . I NEXTWARD="" S NEXTWARD=+VAIP(5)
. . I TRANTYPE<2 Q
. . I TRANTYPE=2,'$$CNGWARD(LOC,+VAIP(15,4),NEXTWARD) Q
. . I $$EXCWARD(LOC,+VAIP(15,4)) Q
. . S OUTDATE=+VAIP(3)
. . S OUTIFN=MOVIFN
. . S OUTTT=TRANTYPE
. . ;
. . S INWARD=+VAIP(15,4)
. . S (INDATE,INIFN,INTT)=""
. . F Q:(VAIP(15)="")!(INIFN) D
. . . S TRANTYPE=$$TRANTYPE(+VAIP(15,3),+VAIP(15,2),VAIP(15),DFN)
. . . S PREVWARD=$P(TRANTYPE,U,2)
. . . S PREVIEN=$P(TRANTYPE,U,3)
. . . S TRANTYPE=$P(TRANTYPE,U,1)
. . . I PREVIEN="" S PREVIEN=VAIP(15)
. . . I TRANTYPE=1 S INDATE=+VAIP(15,1),INIFN=VAIP(15),INTT=1 ;,INWARD=+VAIP(15,4)
. . . I TRANTYPE=2,'PREVWARD D
. . . . D KVA^VADPT S VAIP("E")=PREVIEN D IN5^VADPT
. . . . I $$CNGWARD(LOC,+VAIP(5),+VAIP(15,4)) S INDATE=+VAIP(3),INIFN=VAIP(1),INTT=2 ;,INWARD=+VAIP(16,4)
. . . I TRANTYPE=2,PREVWARD,$$CNGWARD(LOC,PREVWARD,+VAIP(15,4)) S INDATE=+VAIP(15,1),INIFN=VAIP(15),INTT=2
. . . Q:INIFN
. . . D KVA^VADPT
. . . S VAIP("E")=PREVIEN
. . . D IN5^VADPT
. . ;
. . I '$G(INIFN) Q
. . S INLOC=$G(LOC)
. . I +INLOC=0 S INLOC=$$GETLOC(INWARD,.MMRSLOC2)
. . S LOCNAME=$P($G(^MMRS(104.3,INLOC,0)),U)
. . S ^TMP($J,"MMRSIPC","D",LOCNAME,INDATE,DFN,OUTDATE)=INLOC_U_DFN_U_INDATE_U_INIFN_U_INTT_U_OUTDATE_U_OUTIFN_U_OUTTT
;
D KVA^VADPT
;
Q
;
GETNODIS(LOC) ;For Discharge/Transmission report, it adds patients that have not been discharged from the wards to the report
;
; ZEXCEPT: ENDDT,MMRSLOC2
;
N WARD,DFN,TMP,EDT,TT,SDT,INWARD,IEN,INDATE,INTT,INIFN,INLOC,LOCNAME,VAIP
N PREVIEN,PREVWARD
;
S WARD="" F S WARD=$O(^DPT("CN",WARD)) Q:WARD="" D
. S DFN=0 F S DFN=$O(^DPT("CN",WARD,DFN)) Q:'DFN S TMP(DFN)=""
;
S EDT=$$NOW^XLFDT
F TT=1:1:3 S SDT=ENDDT F S SDT=$O(^DGPM("AMV"_TT,SDT)) Q:'SDT!(SDT>EDT) D
. S DFN=0 F S DFN=$O(^DGPM("AMV"_TT,SDT,DFN)) Q:'DFN S TMP(DFN)=""
;
S DFN=0 F S DFN=$O(TMP(DFN)) Q:'DFN D
. D KVA^VADPT
. S VAIP("D")=ENDDT
. D IN5^VADPT
. I 'VAIP(1) Q
. S INWARD=+VAIP(5)
. Q:$$EXCWARD(LOC,INWARD)
. ;
. S INTT=$$TRANTYPE(+VAIP(4),+VAIP(2),VAIP(1),DFN)
. S PREVWARD=$P(INTT,U,2)
. S PREVIEN=$P(INTT,U,4)
. S INTT=$P(INTT,U,1)
. I PREVWARD="" S PREVWARD=+VAIP(15,4)
. I PREVIEN="" S PREVIEN=VAIP(15)
. F Q:(INTT=1)!(INTT=2&$$CNGWARD(LOC,+VAIP(5),PREVWARD))!(PREVIEN="") D
. . S IEN=+PREVIEN
. . D KVA^VADPT
. . S VAIP("E")=IEN
. . D IN5^VADPT
. . S INTT=$$TRANTYPE(+VAIP(4),+VAIP(2),VAIP(1),DFN)
. . S PREVWARD=$P(INTT,U,2)
. . S PREVIEN=$P(INTT,U,4)
. . S INTT=$P(INTT,U,1)
. . I PREVWARD="" S PREVWARD=+VAIP(15,4)
. . I PREVIEN="" S PREVIEN=VAIP(15)
. ;
. I INTT<1!(INTT>2) Q
. S INDATE=+VAIP(3)
. S INIFN=+VAIP(1)
. I '$G(INIFN) Q
. S INLOC=$G(LOC)
. I +INLOC=0 S INLOC=$$GETLOC(INWARD,.MMRSLOC2)
. S LOCNAME=$P($G(^MMRS(104.3,INLOC,0)),U)
. S ^TMP($J,"MMRSIPC","D",LOCNAME,INDATE,DFN," ")=INLOC_U_DFN_U_INDATE_U_INIFN_U_INTT_U_" "_U_"0"_U_" "
;
D KVA^VADPT
;
Q
;
CNGWARD(LOC,WARD1,WARD2) ;Did patient change wards?
;
; ZEXCEPT: MMRSLOC2
;
I +$G(LOC)=0 S LOC=$$GETLOC(WARD1,.MMRSLOC2)
I $D(^MMRS(104.3,LOC,1,"B",WARD1)),$D(^MMRS(104.3,LOC,1,"B",WARD2)) Q 0
Q 1
;
EXCWARD(LOC,WARD) ;Is this ward excluded from the reports?
;
; ZEXCEPT: MMRSLOC2
;
I +$G(LOC)=0 S LOC=$$GETLOC(WARD,.MMRSLOC2)
I LOC=0 Q 1
I $D(^MMRS(104.3,LOC,1,"B",WARD)) Q 0
Q 1
;
DUPLOC(LOC,LCTNS) ;
;
N RSLT,WARD,LOC2
;
S RSLT=0
S WARD=0 F S WARD=$O(^MMRS(104.3,LOC,1,"B",WARD)) Q:'WARD D
.S LOC2=0 F S LOC2=$O(LCTNS(LOC2)) Q:'LOC2 D
..Q:LOC2=LOC
..I $D(^MMRS(104.3,LOC2,1,"B",WARD)) S RSLT=1
Q RSLT
;
GETLOC(WARD,LCTNS) ;
;
N RSLT,LOC
;
S RSLT=0
S LOC=0 F S LOC=$O(LCTNS(LOC)) Q:'LOC!(RSLT) D
.I $D(^MMRS(104.3,LOC,1,"B",WARD)) S RSLT=LOC
Q RSLT
;
TRANTYPE(MOVTYPE,TRANTYPE,MOVIEN,DFN) ;
;
I MOVTYPE=46!(MOVTYPE=5)!(MOVTYPE=6)!(MOVTYPE=7)!(MOVTYPE=47)!(MOVTYPE=27)!(MOVTYPE=33)!(MOVTYPE=3)!(MOVTYPE=22) Q -1 ;MIA/LMT - Removed MOVTYPE 29 ;4/15/10
I MOVTYPE=42!(MOVTYPE=20)!(MOVTYPE=1)!(MOVTYPE=45)!(MOVTYPE=23)!(MOVTYPE=25)!(MOVTYPE=26) Q -1
I MOVTYPE=2!(MOVTYPE=43)!(MOVTYPE=13) Q 3
I MOVTYPE=14!(MOVTYPE=24)!(MOVTYPE=44) Q 1
S TRANTYPE=$$CHKOBS(DFN,MOVIEN,TRANTYPE)
Q TRANTYPE
;
CHKOBS(DFN,MOVIEN,TRANTYPE) ;
; Check if the patient is being discharged from a mixed observation ward (colocated with acute care
; patients) and being immediately admitted to acute care. If yes, we want to consider this
; discharge/admission as an interward transfer.
;
; ZEXCEPT: ODOBS,STRTDT
;
N NEXTMOV,NEXTMOVDT,PREVMOV,PREVMOVDT,SPEC,TIMETOADM,VAIP,VAIP2
;
I TRANTYPE=2 Q TRANTYPE
;
S TIMETOADM=7200 ; 2HRS to allow between obs discharge and acute care admission
;
D KVA^VADPT
S VAIP("E")=MOVIEN
D IN5^VADPT
;
S SPEC=$$GET1^DIQ(45.7,+VAIP(8)_",",1,"I") ;ICR 1154 supported
I TRANTYPE=3,+$$SPEC^DGPMOBS(SPEC)=1,'$$ONLYOBS(+VAIP(5)) D ;ICR 2664 supported
. S NEXTMOVDT=$O(^DGPM("APTT1",DFN,+VAIP(3))) ;ICR 2090
. S NEXTMOV=$O(^DGPM("APTT1",DFN,+NEXTMOVDT,0))
. I 'NEXTMOV Q
. D CALLIN5("VAIP2",DFN,NEXTMOV)
. I $$FMDIFF^XLFDT(+VAIP2(3),+VAIP(3),2)<TIMETOADM D
. . S TRANTYPE=2_U_+VAIP2(5)_U_NEXTMOV_U_VAIP2(16)
;
I TRANTYPE=1 D
. S PREVMOVDT=$O(^DGPM("APTT3",DFN,+VAIP(3)),-1)
. S PREVMOV=$O(^DGPM("APTT3",DFN,+PREVMOVDT,0))
. I 'PREVMOV Q
. D CALLIN5("VAIP2",DFN,PREVMOV)
. S SPEC=$$GET1^DIQ(45.7,+VAIP2(8)_",",1,"I") ;ICR 1154 supported
. I +$$SPEC^DGPMOBS(SPEC)=1,'$$ONLYOBS(+VAIP2(5)),$$FMDIFF^XLFDT(+VAIP(3),+VAIP2(3),2)<TIMETOADM D
. . S TRANTYPE=2_U_+VAIP2(5)_U_PREVMOV_U_VAIP2(15)
. . ; In order not to double count bdoc for one-day obs patients that are admitted to acute care
. . ; keep track of these in ODOBS for later adjustment of BDOC.
. . ; If patient admitted and discharged from mixed obs on same calendar day
. . ; and readmitted to acute care within two hours
. . ; and acute care admission is same calendar day as adm/dis from obs
. . ; and date falls within reporting period
. . I '$G(STRTDT) Q
. . I $P(+VAIP2(13,1),".")=$P(+VAIP2(3),"."),$P(+VAIP2(3),".")=$P(+VAIP(3),"."),(STRTDT-.000001)<+VAIP2(13,1) D Q
. . . S ODOBS(+VAIP2(5))=$G(ODOBS(+VAIP2(5)))+1
. . ;
. . ; if patient admitted to obs on one calendar day and discharged on another
. . ; and readmitted to acute care within two hours
. . ; and acute care admission is same calendar day as adm/dis from obs
. . ; and admitted and discharged from acute care on same calendar day
. . ; and date falls within reporting period
. . ; deduct one from inpatient discharge ward
. . I $P(+VAIP2(13,1),".")'=$P(+VAIP2(3),"."),$P(+VAIP2(3),".")=$P(+VAIP(3),"."),$P(+VAIP(3),".")=$P(+VAIP(17,1),"."),(STRTDT-.000001)<+VAIP(3) D Q
. . . S ODOBS(+VAIP(17,4))=$G(ODOBS(+VAIP(17,4)))+1
;
Q TRANTYPE
;
CALLIN5(RESULT,DFN,MOVIEN) ;
;
N VAIP
;
S VAIP("E")=MOVIEN
S VAIP("V")=RESULT
D IN5^VADPT
Q
;
ONLYOBS(WARD) ;
;
N ONLYOBS,MMRSLOC
;
S ONLYOBS=1
;
S MMRSLOC=0
F S MMRSLOC=$O(^MMRS(104.3,MMRSLOC)) Q:'MMRSLOC!('ONLYOBS) D
. I '$D(^MMRS(104.3,MMRSLOC,1,"B",WARD)) Q
. I $P($G(^MMRS(104.3,MMRSLOC,0)),U,3)?1(1"AC",1"CLC") S ONLYOBS=0
;
Q ONLYOBS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMMRSIPC2 10710 printed Apr 09, 2024@21:17:13 Page 2
MMRSIPC2 ;MIA/LMT - Print MRSA IPEC Report Cont. (Contains functions to collect patient movements) ;02/15/17 10:35
+1 ;;1.0;MRSA PROGRAM TOOLS;**1,5**;Mar 22, 2009;Build 146
+2 ;
+3 ; Reference to ^DGPM("ATT"_X supported by ICR #1865
+4 ; Reference to ^DGPM("APTT"_X supported by ICR #2090
+5 ; Reference to ^DGPM(D0,0) supported by ICR #419
+6 ; Reference to ^DGPM("AMV"_X supported by ICR #419
+7 ; Reference to ^DPT("CN", supported by ICR #5431
+8 ;
+9 ;
GETMOVE ;Collects ward movements for patients that were admitted or discharged in date range.
+1 ;
+2 ; ZEXCEPT: BYADM,MMRSLOC
+3 ;
+4 NEW LOC,DUPLOC,MMRSLOC2
+5 ;
+6 SET LOC=0
FOR
SET LOC=$ORDER(MMRSLOC(LOC))
if 'LOC
QUIT
Begin DoDot:1
+7 SET DUPLOC=$$DUPLOC(LOC,.MMRSLOC)
+8 IF 'DUPLOC
SET MMRSLOC2(LOC)=""
+9 IF DUPLOC
Begin DoDot:2
+10 IF BYADM
DO GETADM(LOC)
+11 IF 'BYADM
DO GETDIS(LOC)
+12 ;For discharge\transmission report show list of patients that have not been discharged yet
IF 'BYADM
DO GETNODIS(LOC)
End DoDot:2
End DoDot:1
+13 IF '$DATA(MMRSLOC2)
QUIT
+14 IF BYADM
DO GETADM(0)
+15 IF 'BYADM
DO GETDIS(0)
+16 ;For discharge\transmission report show list of patients that have not been discharged yet
IF 'BYADM
DO GETNODIS(0)
+17 ;
+18 QUIT
+19 ;
GETADM(LOC) ;
+1 ;
+2 ; ZEXCEPT: MMRSLOC2,STRTDT
+3 ;
+4 NEW TT,MOVDT,MOVIFN,DFN,TRANTYPE,INWARD,INDATE,INIFN,INTT,OUTDATE,OUTIFN,OUTTT,NEXTIEN,LOCNAME,VAIP,INLOC
+5 NEW OUTWARD,PREVWARD
+6 ;
+7 FOR TT=1,2
SET MOVDT=STRTDT-.0000001
FOR
SET MOVDT=$ORDER(^DGPM("ATT"_TT,MOVDT))
if (MOVDT>ENDDT)!('MOVDT)
QUIT
Begin DoDot:1
+8 SET MOVIFN=""
FOR
SET MOVIFN=$ORDER(^DGPM("ATT"_TT,MOVDT,MOVIFN))
if 'MOVIFN
QUIT
Begin DoDot:2
+9 DO KVA^VADPT
SET DFN=$PIECE($GET(^DGPM(MOVIFN,0)),"^",3)
SET VAIP("E")=MOVIFN
DO IN5^VADPT
+10 SET TRANTYPE=$$TRANTYPE(+VAIP(4),+VAIP(2),VAIP(1),DFN)
+11 SET PREVWARD=$PIECE(TRANTYPE,U,2)
+12 SET TRANTYPE=$PIECE(TRANTYPE,U,1)
+13 IF TRANTYPE<1!(TRANTYPE=3)
QUIT
+14 SET INWARD=+VAIP(5)
+15 IF PREVWARD=""
SET PREVWARD=+VAIP(15,4)
+16 IF TRANTYPE=2
IF '$$CNGWARD(LOC,PREVWARD,INWARD)
QUIT
+17 if $$EXCWARD(LOC,INWARD)
QUIT
+18 ;SET GLOBAL
+19 SET INDATE=+VAIP(3)
+20 SET INIFN=MOVIFN
+21 SET INTT=TRANTYPE
+22 ;
+23 SET (OUTDATE,OUTIFN,OUTTT)=" "
+24 FOR
if (VAIP(16)="")!(OUTIFN)
QUIT
Begin DoDot:3
+25 SET TRANTYPE=$$TRANTYPE(+VAIP(16,3),+VAIP(16,2),VAIP(16),DFN)
+26 SET OUTWARD=$PIECE(TRANTYPE,U,2)
+27 SET NEXTIEN=$PIECE(TRANTYPE,U,3)
+28 SET TRANTYPE=$PIECE(TRANTYPE,U,1)
+29 IF OUTWARD=""
SET OUTWARD=+VAIP(16,4)
+30 IF TRANTYPE=3
SET OUTDATE=+VAIP(16,1)
SET OUTIFN=VAIP(16)
SET OUTTT=3
+31 IF TRANTYPE=2
IF $$CNGWARD(LOC,INWARD,OUTWARD)
SET OUTDATE=+VAIP(16,1)
SET OUTIFN=VAIP(16)
SET OUTTT=2
+32 if OUTIFN
QUIT
+33 IF NEXTIEN=""
SET NEXTIEN=VAIP(16)
+34 DO KVA^VADPT
+35 SET VAIP("E")=NEXTIEN
+36 DO IN5^VADPT
End DoDot:3
+37 ;
+38 SET INLOC=$GET(LOC)
+39 IF +INLOC=0
SET INLOC=$$GETLOC(INWARD,.MMRSLOC2)
+40 SET LOCNAME=$PIECE($GET(^MMRS(104.3,INLOC,0)),U)
+41 SET ^TMP($JOB,"MMRSIPC","D",LOCNAME,INDATE,DFN,OUTDATE)=INLOC_U_DFN_U_INDATE_U_INIFN_U_INTT_U_OUTDATE_U_OUTIFN_U_OUTTT
End DoDot:2
End DoDot:1
+42 ;
+43 DO KVA^VADPT
+44 ;
+45 QUIT
+46 ;
GETDIS(LOC) ;
+1 ;
+2 ; ZEXCEPT: MMRSLOC2,STRTDT
+3 ;
+4 NEW TT,MOVDT,MOVIFN,DFN,TRANTYPE,OUTDATE,OUTIFN,OUTTT,INWARD,INDATE,INIFN,INTT,PREVIEN,INLOC,LOCNAME,VAIP
+5 NEW NEXTWARD,PREVWARD
+6 ;
+7 FOR TT=2,3
SET MOVDT=STRTDT-.0000001
FOR
SET MOVDT=$ORDER(^DGPM("ATT"_TT,MOVDT))
if (MOVDT>ENDDT)!('MOVDT)
QUIT
Begin DoDot:1
+8 SET MOVIFN=""
FOR
SET MOVIFN=$ORDER(^DGPM("ATT"_TT,MOVDT,MOVIFN))
if 'MOVIFN
QUIT
Begin DoDot:2
+9 DO KVA^VADPT
SET DFN=$PIECE($GET(^DGPM(MOVIFN,0)),"^",3)
SET VAIP("E")=MOVIFN
DO IN5^VADPT
+10 ;Ignore discharges that are immediate following an Authorized Absence
IF +VAIP(2)=3
IF +VAIP(15,3)=2
QUIT
+11 SET TRANTYPE=$$TRANTYPE(+VAIP(4),+VAIP(2),VAIP(1),DFN)
+12 SET NEXTWARD=$PIECE(TRANTYPE,U,2)
+13 SET TRANTYPE=$PIECE(TRANTYPE,U,1)
+14 IF NEXTWARD=""
SET NEXTWARD=+VAIP(5)
+15 IF TRANTYPE<2
QUIT
+16 IF TRANTYPE=2
IF '$$CNGWARD(LOC,+VAIP(15,4),NEXTWARD)
QUIT
+17 IF $$EXCWARD(LOC,+VAIP(15,4))
QUIT
+18 SET OUTDATE=+VAIP(3)
+19 SET OUTIFN=MOVIFN
+20 SET OUTTT=TRANTYPE
+21 ;
+22 SET INWARD=+VAIP(15,4)
+23 SET (INDATE,INIFN,INTT)=""
+24 FOR
if (VAIP(15)="")!(INIFN)
QUIT
Begin DoDot:3
+25 SET TRANTYPE=$$TRANTYPE(+VAIP(15,3),+VAIP(15,2),VAIP(15),DFN)
+26 SET PREVWARD=$PIECE(TRANTYPE,U,2)
+27 SET PREVIEN=$PIECE(TRANTYPE,U,3)
+28 SET TRANTYPE=$PIECE(TRANTYPE,U,1)
+29 IF PREVIEN=""
SET PREVIEN=VAIP(15)
+30 ;,INWARD=+VAIP(15,4)
IF TRANTYPE=1
SET INDATE=+VAIP(15,1)
SET INIFN=VAIP(15)
SET INTT=1
+31 IF TRANTYPE=2
IF 'PREVWARD
Begin DoDot:4
+32 DO KVA^VADPT
SET VAIP("E")=PREVIEN
DO IN5^VADPT
+33 ;,INWARD=+VAIP(16,4)
IF $$CNGWARD(LOC,+VAIP(5),+VAIP(15,4))
SET INDATE=+VAIP(3)
SET INIFN=VAIP(1)
SET INTT=2
End DoDot:4
+34 IF TRANTYPE=2
IF PREVWARD
IF $$CNGWARD(LOC,PREVWARD,+VAIP(15,4))
SET INDATE=+VAIP(15,1)
SET INIFN=VAIP(15)
SET INTT=2
+35 if INIFN
QUIT
+36 DO KVA^VADPT
+37 SET VAIP("E")=PREVIEN
+38 DO IN5^VADPT
End DoDot:3
+39 ;
+40 IF '$GET(INIFN)
QUIT
+41 SET INLOC=$GET(LOC)
+42 IF +INLOC=0
SET INLOC=$$GETLOC(INWARD,.MMRSLOC2)
+43 SET LOCNAME=$PIECE($GET(^MMRS(104.3,INLOC,0)),U)
+44 SET ^TMP($JOB,"MMRSIPC","D",LOCNAME,INDATE,DFN,OUTDATE)=INLOC_U_DFN_U_INDATE_U_INIFN_U_INTT_U_OUTDATE_U_OUTIFN_U_OUTTT
End DoDot:2
End DoDot:1
+45 ;
+46 DO KVA^VADPT
+47 ;
+48 QUIT
+49 ;
GETNODIS(LOC) ;For Discharge/Transmission report, it adds patients that have not been discharged from the wards to the report
+1 ;
+2 ; ZEXCEPT: ENDDT,MMRSLOC2
+3 ;
+4 NEW WARD,DFN,TMP,EDT,TT,SDT,INWARD,IEN,INDATE,INTT,INIFN,INLOC,LOCNAME,VAIP
+5 NEW PREVIEN,PREVWARD
+6 ;
+7 SET WARD=""
FOR
SET WARD=$ORDER(^DPT("CN",WARD))
if WARD=""
QUIT
Begin DoDot:1
+8 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("CN",WARD,DFN))
if 'DFN
QUIT
SET TMP(DFN)=""
End DoDot:1
+9 ;
+10 SET EDT=$$NOW^XLFDT
+11 FOR TT=1:1:3
SET SDT=ENDDT
FOR
SET SDT=$ORDER(^DGPM("AMV"_TT,SDT))
if 'SDT!(SDT>EDT)
QUIT
Begin DoDot:1
+12 SET DFN=0
FOR
SET DFN=$ORDER(^DGPM("AMV"_TT,SDT,DFN))
if 'DFN
QUIT
SET TMP(DFN)=""
End DoDot:1
+13 ;
+14 SET DFN=0
FOR
SET DFN=$ORDER(TMP(DFN))
if 'DFN
QUIT
Begin DoDot:1
+15 DO KVA^VADPT
+16 SET VAIP("D")=ENDDT
+17 DO IN5^VADPT
+18 IF 'VAIP(1)
QUIT
+19 SET INWARD=+VAIP(5)
+20 if $$EXCWARD(LOC,INWARD)
QUIT
+21 ;
+22 SET INTT=$$TRANTYPE(+VAIP(4),+VAIP(2),VAIP(1),DFN)
+23 SET PREVWARD=$PIECE(INTT,U,2)
+24 SET PREVIEN=$PIECE(INTT,U,4)
+25 SET INTT=$PIECE(INTT,U,1)
+26 IF PREVWARD=""
SET PREVWARD=+VAIP(15,4)
+27 IF PREVIEN=""
SET PREVIEN=VAIP(15)
+28 FOR
if (INTT=1)!(INTT=2&$$CNGWARD(LOC,+VAIP(5),PREVWARD))!(PREVIEN="")
QUIT
Begin DoDot:2
+29 SET IEN=+PREVIEN
+30 DO KVA^VADPT
+31 SET VAIP("E")=IEN
+32 DO IN5^VADPT
+33 SET INTT=$$TRANTYPE(+VAIP(4),+VAIP(2),VAIP(1),DFN)
+34 SET PREVWARD=$PIECE(INTT,U,2)
+35 SET PREVIEN=$PIECE(INTT,U,4)
+36 SET INTT=$PIECE(INTT,U,1)
+37 IF PREVWARD=""
SET PREVWARD=+VAIP(15,4)
+38 IF PREVIEN=""
SET PREVIEN=VAIP(15)
End DoDot:2
+39 ;
+40 IF INTT<1!(INTT>2)
QUIT
+41 SET INDATE=+VAIP(3)
+42 SET INIFN=+VAIP(1)
+43 IF '$GET(INIFN)
QUIT
+44 SET INLOC=$GET(LOC)
+45 IF +INLOC=0
SET INLOC=$$GETLOC(INWARD,.MMRSLOC2)
+46 SET LOCNAME=$PIECE($GET(^MMRS(104.3,INLOC,0)),U)
+47 SET ^TMP($JOB,"MMRSIPC","D",LOCNAME,INDATE,DFN," ")=INLOC_U_DFN_U_INDATE_U_INIFN_U_INTT_U_" "_U_"0"_U_" "
End DoDot:1
+48 ;
+49 DO KVA^VADPT
+50 ;
+51 QUIT
+52 ;
CNGWARD(LOC,WARD1,WARD2) ;Did patient change wards?
+1 ;
+2 ; ZEXCEPT: MMRSLOC2
+3 ;
+4 IF +$GET(LOC)=0
SET LOC=$$GETLOC(WARD1,.MMRSLOC2)
+5 IF $DATA(^MMRS(104.3,LOC,1,"B",WARD1))
IF $DATA(^MMRS(104.3,LOC,1,"B",WARD2))
QUIT 0
+6 QUIT 1
+7 ;
EXCWARD(LOC,WARD) ;Is this ward excluded from the reports?
+1 ;
+2 ; ZEXCEPT: MMRSLOC2
+3 ;
+4 IF +$GET(LOC)=0
SET LOC=$$GETLOC(WARD,.MMRSLOC2)
+5 IF LOC=0
QUIT 1
+6 IF $DATA(^MMRS(104.3,LOC,1,"B",WARD))
QUIT 0
+7 QUIT 1
+8 ;
DUPLOC(LOC,LCTNS) ;
+1 ;
+2 NEW RSLT,WARD,LOC2
+3 ;
+4 SET RSLT=0
+5 SET WARD=0
FOR
SET WARD=$ORDER(^MMRS(104.3,LOC,1,"B",WARD))
if 'WARD
QUIT
Begin DoDot:1
+6 SET LOC2=0
FOR
SET LOC2=$ORDER(LCTNS(LOC2))
if 'LOC2
QUIT
Begin DoDot:2
+7 if LOC2=LOC
QUIT
+8 IF $DATA(^MMRS(104.3,LOC2,1,"B",WARD))
SET RSLT=1
End DoDot:2
End DoDot:1
+9 QUIT RSLT
+10 ;
GETLOC(WARD,LCTNS) ;
+1 ;
+2 NEW RSLT,LOC
+3 ;
+4 SET RSLT=0
+5 SET LOC=0
FOR
SET LOC=$ORDER(LCTNS(LOC))
if 'LOC!(RSLT)
QUIT
Begin DoDot:1
+6 IF $DATA(^MMRS(104.3,LOC,1,"B",WARD))
SET RSLT=LOC
End DoDot:1
+7 QUIT RSLT
+8 ;
TRANTYPE(MOVTYPE,TRANTYPE,MOVIEN,DFN) ;
+1 ;
+2 ;MIA/LMT - Removed MOVTYPE 29 ;4/15/10
IF MOVTYPE=46!(MOVTYPE=5)!(MOVTYPE=6)!(MOVTYPE=7)!(MOVTYPE=47)!(MOVTYPE=27)!(MOVTYPE=33)!(MOVTYPE=3)!(MOVTYPE=22)
QUIT -1
+3 IF MOVTYPE=42!(MOVTYPE=20)!(MOVTYPE=1)!(MOVTYPE=45)!(MOVTYPE=23)!(MOVTYPE=25)!(MOVTYPE=26)
QUIT -1
+4 IF MOVTYPE=2!(MOVTYPE=43)!(MOVTYPE=13)
QUIT 3
+5 IF MOVTYPE=14!(MOVTYPE=24)!(MOVTYPE=44)
QUIT 1
+6 SET TRANTYPE=$$CHKOBS(DFN,MOVIEN,TRANTYPE)
+7 QUIT TRANTYPE
+8 ;
CHKOBS(DFN,MOVIEN,TRANTYPE) ;
+1 ; Check if the patient is being discharged from a mixed observation ward (colocated with acute care
+2 ; patients) and being immediately admitted to acute care. If yes, we want to consider this
+3 ; discharge/admission as an interward transfer.
+4 ;
+5 ; ZEXCEPT: ODOBS,STRTDT
+6 ;
+7 NEW NEXTMOV,NEXTMOVDT,PREVMOV,PREVMOVDT,SPEC,TIMETOADM,VAIP,VAIP2
+8 ;
+9 IF TRANTYPE=2
QUIT TRANTYPE
+10 ;
+11 ; 2HRS to allow between obs discharge and acute care admission
SET TIMETOADM=7200
+12 ;
+13 DO KVA^VADPT
+14 SET VAIP("E")=MOVIEN
+15 DO IN5^VADPT
+16 ;
+17 ;ICR 1154 supported
SET SPEC=$$GET1^DIQ(45.7,+VAIP(8)_",",1,"I")
+18 ;ICR 2664 supported
IF TRANTYPE=3
IF +$$SPEC^DGPMOBS(SPEC)=1
IF '$$ONLYOBS(+VAIP(5))
Begin DoDot:1
+19 ;ICR 2090
SET NEXTMOVDT=$ORDER(^DGPM("APTT1",DFN,+VAIP(3)))
+20 SET NEXTMOV=$ORDER(^DGPM("APTT1",DFN,+NEXTMOVDT,0))
+21 IF 'NEXTMOV
QUIT
+22 DO CALLIN5("VAIP2",DFN,NEXTMOV)
+23 IF $$FMDIFF^XLFDT(+VAIP2(3),+VAIP(3),2)<TIMETOADM
Begin DoDot:2
+24 SET TRANTYPE=2_U_+VAIP2(5)_U_NEXTMOV_U_VAIP2(16)
End DoDot:2
End DoDot:1
+25 ;
+26 IF TRANTYPE=1
Begin DoDot:1
+27 SET PREVMOVDT=$ORDER(^DGPM("APTT3",DFN,+VAIP(3)),-1)
+28 SET PREVMOV=$ORDER(^DGPM("APTT3",DFN,+PREVMOVDT,0))
+29 IF 'PREVMOV
QUIT
+30 DO CALLIN5("VAIP2",DFN,PREVMOV)
+31 ;ICR 1154 supported
SET SPEC=$$GET1^DIQ(45.7,+VAIP2(8)_",",1,"I")
+32 IF +$$SPEC^DGPMOBS(SPEC)=1
IF '$$ONLYOBS(+VAIP2(5))
IF $$FMDIFF^XLFDT(+VAIP(3),+VAIP2(3),2)<TIMETOADM
Begin DoDot:2
+33 SET TRANTYPE=2_U_+VAIP2(5)_U_PREVMOV_U_VAIP2(15)
+34 ; In order not to double count bdoc for one-day obs patients that are admitted to acute care
+35 ; keep track of these in ODOBS for later adjustment of BDOC.
+36 ; If patient admitted and discharged from mixed obs on same calendar day
+37 ; and readmitted to acute care within two hours
+38 ; and acute care admission is same calendar day as adm/dis from obs
+39 ; and date falls within reporting period
+40 IF '$GET(STRTDT)
QUIT
+41 IF $PIECE(+VAIP2(13,1),".")=$PIECE(+VAIP2(3),".")
IF $PIECE(+VAIP2(3),".")=$PIECE(+VAIP(3),".")
IF (STRTDT-.000001)<+VAIP2(13,1)
Begin DoDot:3
+42 SET ODOBS(+VAIP2(5))=$GET(ODOBS(+VAIP2(5)))+1
End DoDot:3
QUIT
+43 ;
+44 ; if patient admitted to obs on one calendar day and discharged on another
+45 ; and readmitted to acute care within two hours
+46 ; and acute care admission is same calendar day as adm/dis from obs
+47 ; and admitted and discharged from acute care on same calendar day
+48 ; and date falls within reporting period
+49 ; deduct one from inpatient discharge ward
+50 IF $PIECE(+VAIP2(13,1),".")'=$PIECE(+VAIP2(3),".")
IF $PIECE(+VAIP2(3),".")=$PIECE(+VAIP(3),".")
IF $PIECE(+VAIP(3),".")=$PIECE(+VAIP(17,1),".")
IF (STRTDT-.000001)<+VAIP(3)
Begin DoDot:3
+51 SET ODOBS(+VAIP(17,4))=$GET(ODOBS(+VAIP(17,4)))+1
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+52 ;
+53 QUIT TRANTYPE
+54 ;
CALLIN5(RESULT,DFN,MOVIEN) ;
+1 ;
+2 NEW VAIP
+3 ;
+4 SET VAIP("E")=MOVIEN
+5 SET VAIP("V")=RESULT
+6 DO IN5^VADPT
+7 QUIT
+8 ;
ONLYOBS(WARD) ;
+1 ;
+2 NEW ONLYOBS,MMRSLOC
+3 ;
+4 SET ONLYOBS=1
+5 ;
+6 SET MMRSLOC=0
+7 FOR
SET MMRSLOC=$ORDER(^MMRS(104.3,MMRSLOC))
if 'MMRSLOC!('ONLYOBS)
QUIT
Begin DoDot:1
+8 IF '$DATA(^MMRS(104.3,MMRSLOC,1,"B",WARD))
QUIT
+9 IF $PIECE($GET(^MMRS(104.3,MMRSLOC,0)),U,3)?1(1"AC",1"CLC")
SET ONLYOBS=0
End DoDot:1
+10 ;
+11 QUIT ONLYOBS
