MMRSIPC2.m

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 ---MMRSIPC2   10710     printed  Feb 18, 2025@23:41:25                                                                                                                                                                                                   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)