VSITSTAT ;ISL/PKR - Visit Tracking in/out patient Update Protocol for ADT ;04/14/2022
;;1.0;PCE PATIENT CARE ENCOUNTER;**76,231**;Aug 12, 1996;Build 1
; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
; the incorporation of the module into PCE. For historical reference,
; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
; patches.
;
;;2.0;VISIT TRACKING;**2**;Aug 12, 1996
;
;==========
ADMISSION(ADMDATA,VAIP) ;If there is an admission save the data.
;If the movement is just a change in discharge time UTILITY(...1,...)
;will not exist.
N MVMNT,WARD
S MVMNT=$O(^UTILITY("DGPM",$J,1,""))
I MVMNT D
. S ADMDATA("A","DT")=$P($G(^UTILITY("DGPM",$J,1,MVMNT,"A")),U,1)
. S ADMDATA("P","DT")=$P($G(^UTILITY("DGPM",$J,1,MVMNT,"P")),U,1)
E D
. S ADMDATA("A","DT")=$P(VAIP(13,1),U,1)
. S ADMDATA("P","DT")=ADMDATA("A","DT") ;no ^UTILITY = no change
Q
;
;==========
DISCHARGE(DISDATA,VAIP) ;If there is a discharge save the data.
N MVMNT,WARD
S MVMNT=$O(^UTILITY("DGPM",$J,3,""))
I MVMNT D
. S DISDATA("A","DT")=$P($G(^UTILITY("DGPM",$J,3,MVMNT,"A")),U,1)
. S DISDATA("P","DT")=$P($G(^UTILITY("DGPM",$J,3,MVMNT,"P")),U,1)
E D
. S DISDATA("A","DT")=$P(VAIP(17,1),U,1)
. S DISDATA("P","DT")=DISDATA("A","DT") ;no ^UTILITY = no change
Q
;
;==========
EN ;Main entry point, invoked by the DGPM MOVEMENT EVENTS protocol.
;If admission or discharge dates change, a scan for visits in the affected
;date range is made to update the SERVICE CATEGORY and PATIENT STATUS IN/OUT
;fields accordingly.
;
;If the admission date/time changes, a search is made for the admission visit and
;VISIT/ADMIT DATE&TIME is updated to the new admission DATE/TIME. If there is no
;admission visit, then one is created.
;
I '$D(^UTILITY("DGPM",$J,1))&'$D(^UTILITY("DGPM",$J,3)) Q
W:'$G(DGQUIET) !!,"Updating visit status..."
;
N ADMDATA,DISDATA,VAIP
;
;Try to get complete information for the movement.
S VAIP("E")=DGPMDA
D IN5^VADPT
;
;Setup the admission information.
D ADMISSION(.ADMDATA,.VAIP)
;
;Setup the discharge information.
D DISCHARGE(.DISDATA,.VAIP)
;
;We must have a value either for the admission after or previous.
I (ADMDATA("A","DT")="")&(ADMDATA("P","DT")="") D Q
. W:'$G(DGQUIET) !,"VSITSTAT FATAL ERROR -- NO ADMISSION TIME"
;
N HLOC,IN,INOUT,OUT,SDBEG,SDEND
S IN=1,OUT=0
;
;New Admission.
I (ADMDATA("A","DT")>0),(ADMDATA("P","DT")="") D
. S SDBEG=ADMDATA("A","DT")
. I +DISDATA("A","DT")>0 S SDEND=DISDATA("A","DT")
. E S SDEND=9999999
. S INOUT=IN
. D SCANUPD(DFN,SDBEG,SDEND,INOUT)
;
;Admission edited, date earlier than previous admission date.
I (ADMDATA("A","DT")>0),(ADMDATA("A","DT")<ADMDATA("P","DT")) D
. S SDBEG=ADMDATA("A","DT")
. S SDEND=ADMDATA("P","DT")
. S INOUT=IN
. D SCANUPD(DFN,SDBEG,SDEND,INOUT)
;
;Admission edited, date later than previous admission date.
I (ADMDATA("P","DT")>0),(ADMDATA("A","DT")>ADMDATA("P","DT")) D
. S SDBEG=ADMDATA("P","DT")
. S SDEND=ADMDATA("A","DT")
. S INOUT=OUT
. D SCANUPD(DFN,SDBEG,SDEND,INOUT)
;
;Admission deleted.
I (ADMDATA("P","DT")>0),(ADMDATA("A","DT")="") D
. S SDBEG=ADMDATA("P","DT")
. I +DISDATA("P","DT")>0 S SDEND=DISDATA("P","DT")
. E S SDEND=9999999
. S INOUT=OUT
. D SCANUPD(DFN,SDBEG,SDEND,INOUT)
;
;Discharge added.
I (ADMDATA("A","DT")=ADMDATA("P","DT")),(DISDATA("P","DT")="")&(DISDATA("A","DT")>0) D
. S SDBEG=DISDATA("A","DT")
. S SDEND=9999999
. S INOUT=OUT
. D SCANUPD(DFN,SDBEG,SDEND,INOUT)
;
;New discharge date earlier than previous discharge date.
I (DISDATA("A","DT")>0),(DISDATA("A","DT")<DISDATA("P","DT")) D
. S SDBEG=DISDATA("A","DT")
. S SDEND=DISDATA("P","DT")
. S INOUT=OUT
. D SCANUPD(DFN,SDBEG,SDEND,INOUT)
;
;New discharge date later than previous discharge date.
I (DISDATA("P","DT")>0),(DISDATA("A","DT")>DISDATA("P","DT")) D
. S SDBEG=DISDATA("P","DT")
. S SDEND=DISDATA("A","DT")
. S INOUT=IN
. D SCANUPD(DFN,SDBEG,SDEND,INOUT)
;
;Discharge deleted.
I (ADMDATA("A","DT")=ADMDATA("P","DT")),(DISDATA("A","DT")="")&(DISDATA("P","DT")>0) D
. S SDBEG=ADMDATA("P","DT")
. S SDEND=DISDATA("P","DT")
. S INOUT=IN
. D SCANUPD(DFN,SDBEG,SDEND,INOUT)
;
;Any admission created or edited
N VSITMVT,AFTER,PRIOR
S VSITMVT=0 F S VSITMVT=$O(^UTILITY("DGPM",$J,1,VSITMVT)) Q:VSITMVT<1 D
. S AFTER=$G(^UTILITY("DGPM",$J,1,VSITMVT,"A")),PRIOR=$G(^("P"))
. ;no addl visit updates if deleted, or date & location unchanged
. Q:PRIOR&(AFTER="") I +AFTER=+PRIOR,$P(AFTER,U,6)=$P(PRIOR,U,6) Q
. D UPDADMVISIT(DFN,PRIOR,AFTER)
;
W:'$G(DGQUIET) "completed."
;
ENQ ;
D KVA^VADPT
Q
;
;===========
FINDADMVISIT(DFN,HLOC,ADMDT) ;Given the DFN, hospital location, and
;admission date and time try to find the corresponding Visit file entry.
N ADMVISIT,VISITIEN
I '$D(^AUPNVSIT("AET",DFN,ADMDT,HLOC,"P")) Q 0
S ADMVISIT=0,VISITIEN=""
F S VISITIEN=$O(^AUPNVSIT("AET",DFN,ADMDT,HLOC,"P",VISITIEN)) Q:VISITIEN="" D Q:ADMVISIT>0
. I $P(^AUPNVSIT(VISITIEN,0),U,7)'="H" Q
. S ADMVISIT=VISITIEN
Q ADMVISIT
;
;==========
SCANUPD(DFN,BEGDT,ENDDT,INOUT) ;Scan a date range of visits and update
;SERVICE CATEGORY and PATIENT STATUS IN/OUT.
; input:
; DFN = patient
; BEGDT = beginning date
; ENDDT = end date
; INOUT = PATIENT STATUS IN/OUT
;
N INVDT,INVEND,VISITIEN,VSIT
S INVDT=(9999999-$E(ENDDT,1,7))_$E(ENDDT,8,14)-.0000001
S INVEND=(9999999-$E(BEGDT,1,7))_$E(BEGDT,8,14)
F S INVDT=+$O(^AUPNVSIT("AA",DFN,INVDT)) Q:(INVDT>INVEND)!(INVDT=0) D
. S VISITIEN=""
. F S VISITIEN=$O(^AUPNVSIT("AA",DFN,INVDT,VISITIEN)) Q:VISITIEN="" D
.. S VSIT("IEN")=VISITIEN
.. S VSIT("IO")=INOUT
.. S VSIT("MDT")=$$NOW^XLFDT
.. S VSIT("SVC")=$$UPDSCAT(VISITIEN,INOUT)
.. D UPD^VSIT
Q
;
;==========
UPDADMVISIT(DFN,PRIOR,AFTER) ;Update the VISIT/ADMIT DATE&TIME to the new
;admission date and time. If an admission visit does not exist, create one.
N ADMVISIT,VDT,HLOC,VSIT,Y
S VDT=+$P(PRIOR,U,1),HLOC=+$G(^DIC(42,+$P(PRIOR,U,6),44))
S ADMVISIT=$$FINDADMVISIT(DFN,HLOC,VDT)
I ADMVISIT>0 D Q
. S VSIT("IEN")=ADMVISIT
. S VSIT("MDT")=$$NOW^XLFDT
. S VSIT("VDT")=$P(AFTER,U,1)
. S VSIT("LOC")=$G(^DIC(42,+$P(AFTER,U,6),44))
. D UPD^VSIT
I ADMVISIT=0 D
. S VDT=+$P(AFTER,U,1)
. S VSIT("PRI")="P",VSIT("SVC")="H"
. S VSIT("LOC")=$G(^DIC(42,+$P(AFTER,U,6),44))
. S (VSIT("CDT"),VSIT("MDT"))=$$NOW^XLFDT
. S VSIT("PKG")="PX"
. S VSIT("SOR")=$$SOURCE^PXAPIUTL("DGPM MOVEMENT EVENT - VSITSTATUS")
. S Y=$$GET^VSIT(VDT,DFN,"EF",.VSIT)
Q
;
;==========
UPDSCAT(VISITIEN,INOUT) ;Set the Service Category for in or outpatient.
N CSC,NSC
S (CSC,NSC)=$P($G(^AUPNVSIT(VISITIEN,0)),U,7)
I (CSC="A")!(CSC="I") D
. I INOUT S NSC="I"
. E S NSC="A"
;
I (CSC="D")!(CSC="X") D
. I INOUT S NSC="D"
. E S NSC="X"
;
;If the current Service Category was not A, I, D, or X return the original.
Q NSC
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVSITSTAT 7100 printed Dec 13, 2024@02:32:41 Page 2
VSITSTAT ;ISL/PKR - Visit Tracking in/out patient Update Protocol for ADT ;04/14/2022
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76,231**;Aug 12, 1996;Build 1
+2 ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
+3 ; the incorporation of the module into PCE. For historical reference,
+4 ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
+5 ; patches.
+6 ;
+7 ;;2.0;VISIT TRACKING;**2**;Aug 12, 1996
+8 ;
+9 ;==========
ADMISSION(ADMDATA,VAIP) ;If there is an admission save the data.
+1 ;If the movement is just a change in discharge time UTILITY(...1,...)
+2 ;will not exist.
+3 NEW MVMNT,WARD
+4 SET MVMNT=$ORDER(^UTILITY("DGPM",$JOB,1,""))
+5 IF MVMNT
Begin DoDot:1
+6 SET ADMDATA("A","DT")=$PIECE($GET(^UTILITY("DGPM",$JOB,1,MVMNT,"A")),U,1)
+7 SET ADMDATA("P","DT")=$PIECE($GET(^UTILITY("DGPM",$JOB,1,MVMNT,"P")),U,1)
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 SET ADMDATA("A","DT")=$PIECE(VAIP(13,1),U,1)
+10 ;no ^UTILITY = no change
SET ADMDATA("P","DT")=ADMDATA("A","DT")
End DoDot:1
+11 QUIT
+12 ;
+13 ;==========
DISCHARGE(DISDATA,VAIP) ;If there is a discharge save the data.
+1 NEW MVMNT,WARD
+2 SET MVMNT=$ORDER(^UTILITY("DGPM",$JOB,3,""))
+3 IF MVMNT
Begin DoDot:1
+4 SET DISDATA("A","DT")=$PIECE($GET(^UTILITY("DGPM",$JOB,3,MVMNT,"A")),U,1)
+5 SET DISDATA("P","DT")=$PIECE($GET(^UTILITY("DGPM",$JOB,3,MVMNT,"P")),U,1)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 SET DISDATA("A","DT")=$PIECE(VAIP(17,1),U,1)
+8 ;no ^UTILITY = no change
SET DISDATA("P","DT")=DISDATA("A","DT")
End DoDot:1
+9 QUIT
+10 ;
+11 ;==========
EN ;Main entry point, invoked by the DGPM MOVEMENT EVENTS protocol.
+1 ;If admission or discharge dates change, a scan for visits in the affected
+2 ;date range is made to update the SERVICE CATEGORY and PATIENT STATUS IN/OUT
+3 ;fields accordingly.
+4 ;
+5 ;If the admission date/time changes, a search is made for the admission visit and
+6 ;VISIT/ADMIT DATE&TIME is updated to the new admission DATE/TIME. If there is no
+7 ;admission visit, then one is created.
+8 ;
+9 IF '$DATA(^UTILITY("DGPM",$JOB,1))&'$DATA(^UTILITY("DGPM",$JOB,3))
QUIT
+10 if '$GET(DGQUIET)
WRITE !!,"Updating visit status..."
+11 ;
+12 NEW ADMDATA,DISDATA,VAIP
+13 ;
+14 ;Try to get complete information for the movement.
+15 SET VAIP("E")=DGPMDA
+16 DO IN5^VADPT
+17 ;
+18 ;Setup the admission information.
+19 DO ADMISSION(.ADMDATA,.VAIP)
+20 ;
+21 ;Setup the discharge information.
+22 DO DISCHARGE(.DISDATA,.VAIP)
+23 ;
+24 ;We must have a value either for the admission after or previous.
+25 IF (ADMDATA("A","DT")="")&(ADMDATA("P","DT")="")
Begin DoDot:1
+26 if '$GET(DGQUIET)
WRITE !,"VSITSTAT FATAL ERROR -- NO ADMISSION TIME"
End DoDot:1
QUIT
+27 ;
+28 NEW HLOC,IN,INOUT,OUT,SDBEG,SDEND
+29 SET IN=1
SET OUT=0
+30 ;
+31 ;New Admission.
+32 IF (ADMDATA("A","DT")>0)
IF (ADMDATA("P","DT")="")
Begin DoDot:1
+33 SET SDBEG=ADMDATA("A","DT")
+34 IF +DISDATA("A","DT")>0
SET SDEND=DISDATA("A","DT")
+35 IF '$TEST
SET SDEND=9999999
+36 SET INOUT=IN
+37 DO SCANUPD(DFN,SDBEG,SDEND,INOUT)
End DoDot:1
+38 ;
+39 ;Admission edited, date earlier than previous admission date.
+40 IF (ADMDATA("A","DT")>0)
IF (ADMDATA("A","DT")<ADMDATA("P","DT"))
Begin DoDot:1
+41 SET SDBEG=ADMDATA("A","DT")
+42 SET SDEND=ADMDATA("P","DT")
+43 SET INOUT=IN
+44 DO SCANUPD(DFN,SDBEG,SDEND,INOUT)
End DoDot:1
+45 ;
+46 ;Admission edited, date later than previous admission date.
+47 IF (ADMDATA("P","DT")>0)
IF (ADMDATA("A","DT")>ADMDATA("P","DT"))
Begin DoDot:1
+48 SET SDBEG=ADMDATA("P","DT")
+49 SET SDEND=ADMDATA("A","DT")
+50 SET INOUT=OUT
+51 DO SCANUPD(DFN,SDBEG,SDEND,INOUT)
End DoDot:1
+52 ;
+53 ;Admission deleted.
+54 IF (ADMDATA("P","DT")>0)
IF (ADMDATA("A","DT")="")
Begin DoDot:1
+55 SET SDBEG=ADMDATA("P","DT")
+56 IF +DISDATA("P","DT")>0
SET SDEND=DISDATA("P","DT")
+57 IF '$TEST
SET SDEND=9999999
+58 SET INOUT=OUT
+59 DO SCANUPD(DFN,SDBEG,SDEND,INOUT)
End DoDot:1
+60 ;
+61 ;Discharge added.
+62 IF (ADMDATA("A","DT")=ADMDATA("P","DT"))
IF (DISDATA("P","DT")="")&(DISDATA("A","DT")>0)
Begin DoDot:1
+63 SET SDBEG=DISDATA("A","DT")
+64 SET SDEND=9999999
+65 SET INOUT=OUT
+66 DO SCANUPD(DFN,SDBEG,SDEND,INOUT)
End DoDot:1
+67 ;
+68 ;New discharge date earlier than previous discharge date.
+69 IF (DISDATA("A","DT")>0)
IF (DISDATA("A","DT")<DISDATA("P","DT"))
Begin DoDot:1
+70 SET SDBEG=DISDATA("A","DT")
+71 SET SDEND=DISDATA("P","DT")
+72 SET INOUT=OUT
+73 DO SCANUPD(DFN,SDBEG,SDEND,INOUT)
End DoDot:1
+74 ;
+75 ;New discharge date later than previous discharge date.
+76 IF (DISDATA("P","DT")>0)
IF (DISDATA("A","DT")>DISDATA("P","DT"))
Begin DoDot:1
+77 SET SDBEG=DISDATA("P","DT")
+78 SET SDEND=DISDATA("A","DT")
+79 SET INOUT=IN
+80 DO SCANUPD(DFN,SDBEG,SDEND,INOUT)
End DoDot:1
+81 ;
+82 ;Discharge deleted.
+83 IF (ADMDATA("A","DT")=ADMDATA("P","DT"))
IF (DISDATA("A","DT")="")&(DISDATA("P","DT")>0)
Begin DoDot:1
+84 SET SDBEG=ADMDATA("P","DT")
+85 SET SDEND=DISDATA("P","DT")
+86 SET INOUT=IN
+87 DO SCANUPD(DFN,SDBEG,SDEND,INOUT)
End DoDot:1
+88 ;
+89 ;Any admission created or edited
+90 NEW VSITMVT,AFTER,PRIOR
+91 SET VSITMVT=0
FOR
SET VSITMVT=$ORDER(^UTILITY("DGPM",$JOB,1,VSITMVT))
if VSITMVT<1
QUIT
Begin DoDot:1
+92 SET AFTER=$GET(^UTILITY("DGPM",$JOB,1,VSITMVT,"A"))
SET PRIOR=$GET(^("P"))
+93 ;no addl visit updates if deleted, or date & location unchanged
+94 if PRIOR&(AFTER="")
QUIT
IF +AFTER=+PRIOR
IF $PIECE(AFTER,U,6)=$PIECE(PRIOR,U,6)
QUIT
+95 DO UPDADMVISIT(DFN,PRIOR,AFTER)
End DoDot:1
+96 ;
+97 if '$GET(DGQUIET)
WRITE "completed."
+98 ;
ENQ ;
+1 DO KVA^VADPT
+2 QUIT
+3 ;
+4 ;===========
FINDADMVISIT(DFN,HLOC,ADMDT) ;Given the DFN, hospital location, and
+1 ;admission date and time try to find the corresponding Visit file entry.
+2 NEW ADMVISIT,VISITIEN
+3 IF '$DATA(^AUPNVSIT("AET",DFN,ADMDT,HLOC,"P"))
QUIT 0
+4 SET ADMVISIT=0
SET VISITIEN=""
+5 FOR
SET VISITIEN=$ORDER(^AUPNVSIT("AET",DFN,ADMDT,HLOC,"P",VISITIEN))
if VISITIEN=""
QUIT
Begin DoDot:1
+6 IF $PIECE(^AUPNVSIT(VISITIEN,0),U,7)'="H"
QUIT
+7 SET ADMVISIT=VISITIEN
End DoDot:1
if ADMVISIT>0
QUIT
+8 QUIT ADMVISIT
+9 ;
+10 ;==========
SCANUPD(DFN,BEGDT,ENDDT,INOUT) ;Scan a date range of visits and update
+1 ;SERVICE CATEGORY and PATIENT STATUS IN/OUT.
+2 ; input:
+3 ; DFN = patient
+4 ; BEGDT = beginning date
+5 ; ENDDT = end date
+6 ; INOUT = PATIENT STATUS IN/OUT
+7 ;
+8 NEW INVDT,INVEND,VISITIEN,VSIT
+9 SET INVDT=(9999999-$EXTRACT(ENDDT,1,7))_$EXTRACT(ENDDT,8,14)-.0000001
+10 SET INVEND=(9999999-$EXTRACT(BEGDT,1,7))_$EXTRACT(BEGDT,8,14)
+11 FOR
SET INVDT=+$ORDER(^AUPNVSIT("AA",DFN,INVDT))
if (INVDT>INVEND)!(INVDT=0)
QUIT
Begin DoDot:1
+12 SET VISITIEN=""
+13 FOR
SET VISITIEN=$ORDER(^AUPNVSIT("AA",DFN,INVDT,VISITIEN))
if VISITIEN=""
QUIT
Begin DoDot:2
+14 SET VSIT("IEN")=VISITIEN
+15 SET VSIT("IO")=INOUT
+16 SET VSIT("MDT")=$$NOW^XLFDT
+17 SET VSIT("SVC")=$$UPDSCAT(VISITIEN,INOUT)
+18 DO UPD^VSIT
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+21 ;==========
UPDADMVISIT(DFN,PRIOR,AFTER) ;Update the VISIT/ADMIT DATE&TIME to the new
+1 ;admission date and time. If an admission visit does not exist, create one.
+2 NEW ADMVISIT,VDT,HLOC,VSIT,Y
+3 SET VDT=+$PIECE(PRIOR,U,1)
SET HLOC=+$GET(^DIC(42,+$PIECE(PRIOR,U,6),44))
+4 SET ADMVISIT=$$FINDADMVISIT(DFN,HLOC,VDT)
+5 IF ADMVISIT>0
Begin DoDot:1
+6 SET VSIT("IEN")=ADMVISIT
+7 SET VSIT("MDT")=$$NOW^XLFDT
+8 SET VSIT("VDT")=$PIECE(AFTER,U,1)
+9 SET VSIT("LOC")=$GET(^DIC(42,+$PIECE(AFTER,U,6),44))
+10 DO UPD^VSIT
End DoDot:1
QUIT
+11 IF ADMVISIT=0
Begin DoDot:1
+12 SET VDT=+$PIECE(AFTER,U,1)
+13 SET VSIT("PRI")="P"
SET VSIT("SVC")="H"
+14 SET VSIT("LOC")=$GET(^DIC(42,+$PIECE(AFTER,U,6),44))
+15 SET (VSIT("CDT"),VSIT("MDT"))=$$NOW^XLFDT
+16 SET VSIT("PKG")="PX"
+17 SET VSIT("SOR")=$$SOURCE^PXAPIUTL("DGPM MOVEMENT EVENT - VSITSTATUS")
+18 SET Y=$$GET^VSIT(VDT,DFN,"EF",.VSIT)
End DoDot:1
+19 QUIT
+20 ;
+21 ;==========
UPDSCAT(VISITIEN,INOUT) ;Set the Service Category for in or outpatient.
+1 NEW CSC,NSC
+2 SET (CSC,NSC)=$PIECE($GET(^AUPNVSIT(VISITIEN,0)),U,7)
+3 IF (CSC="A")!(CSC="I")
Begin DoDot:1
+4 IF INOUT
SET NSC="I"
+5 IF '$TEST
SET NSC="A"
End DoDot:1
+6 ;
+7 IF (CSC="D")!(CSC="X")
Begin DoDot:1
+8 IF INOUT
SET NSC="D"
+9 IF '$TEST
SET NSC="X"
End DoDot:1
+10 ;
+11 ;If the current Service Category was not A, I, D, or X return the original.
+12 QUIT NSC
+13 ;
