VSITSTAT ;ISL/PKR - Visit Tracking in/out patient Update Protocol for ADT ;4/23/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996
; 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
;
EN ;Main entry point called by ADT event driver, process adm and d/c only.
I '$D(^UTILITY("DGPM",$J,1))&'$D(^UTILITY("DGPM",$J,3)) G ENQ
W:'$G(DGQUIET) !!,"Updating visit status..."
;
N MAXDATE,TOFFSET
S MAXDATE=9999999
S TOFFSET=.0000001
;
;Build a time ordered list of visits for this patient.
N DATE,TIME,VDT,VIEN
S VDT=""
F S VDT=$O(^AUPNVSIT("AA",DFN,VDT)) Q:'VDT D
. S VIEN="",VIEN=$O(^AUPNVSIT("AA",DFN,VDT,VIEN))
. S DATE=$P(VDT,".",1)
. S TIME=VDT-DATE
. S DATE=MAXDATE-DATE+TIME
. S ^TMP("VSITSTAT",$J,DFN,DATE,VIEN)=""
;
;Try to get information for the complete movement.
S VAIP("E")=DGPMDA
D IN5^VADPT
;
;Setup the admission information.
N ADMA,ADMIT
S ADMIT=$$ADMISSIO(.ADMA)
;
;Setup the discharge information.
N DISA,DISCHG
S DISCHG=$$DISCHARG(.DISA)
;
;We must have a value either for the admission after or previous.
I (ADMA("A")="")&(ADMA("P")="") D Q
. W !,"VSITSTAT FATAL ERROR -- NO ADMISSION TIME"
;
N IN,INOUT,OUT,SDBEG,SDEND
S IN=1,OUT=0
;
;General, this handles admission add and parts of admission change
;delete change.
I (+ADMA("A")>0)&(ADMA("A")'=ADMA("P")) D
. S SDBEG=ADMA("A")-TOFFSET
. I DISCHG S SDEND=DISA("A")
. E S SDEND=MAXDATE
. S INOUT=IN
. D SCANUPD(SDBEG,SDEND,INOUT)
;
;Admission change. We only need to worry about a latter time. The
;earlier case is entirely handled above.
I (+ADMA("P")>0)&(+ADMA("P")<+ADMA("A")) D
. S SDBEG=ADMA("P")
. S SDEND=ADMA("A")-TOFFSET
. S INOUT=OUT
. D SCANUPD(SDBEG,SDEND,INOUT)
;
;Admission delete.
I (+ADMA("P")>0)&(ADMA("A")="") D
. S SDBEG=ADMA("P")-TOFFSET
. I +DISA("P")>0 S SDEND=DISA("P")
. E S SDEND=MAXDATE
. S INOUT=OUT
. D SCANUPD(SDBEG,SDEND,INOUT)
;
;Discharge add.
I (ADMA("A")=ADMA("P"))&(+DISA("A")>0) D
. S SDBEG=DISA("A")+TOFFSET
. S SDEND=MAXDATE
. S INOUT=OUT
. D SCANUPD(SDBEG,SDEND,INOUT)
;
;Discharge change. We only need to worry about an earlier discharge
;time.
I (+DISA("A")>0)&(+DISA("A")<+DISA("P")) D
. S SDBEG=DISA("A")+TOFFSET
. S SDEND=DISA("P")
. S INOUT=OUT
. D SCANUPD(SDBEG,SDEND,INOUT)
;
;Discharge delete.
I (ADMA("A")=ADMA("P"))&(+DISA("P")>0)&(DISA("A")="") D
. S SDBEG=ADMA("A")-TOFFSET
. S SDEND=DISA("P")
. S INOUT=IN
. D SCANUPD(SDBEG,SDEND,INOUT)
;
W:'$G(DGQUIET) "completed."
;
ENQ ;
K ^TMP("VSITSTAT",$J,DFN)
D KVA^VADPT
Q
;
;=======================================================================
ADMISSIO(ADMA) ;Return true if there is an admission.
;
;If the movement is just a change in discharge time UTILITY(...1,...)
;will not exist.
N MVMNT
S MVMNT="",MVMNT=$O(^UTILITY("DGPM",$J,1,MVMNT))
I MVMNT D
. S ADMA("A")=$P($G(^UTILITY("DGPM",$J,1,MVMNT,"A")),U,1)
. S ADMA("P")=$P($G(^UTILITY("DGPM",$J,1,MVMNT,"P")),U,1)
E D
. S ADMA("A")=$P(VAIP(13,1),U,1)
. I VAIP(13)=DGPMDA S ADMA("P")=$P(DGPMP,U,1)
. E S ADMA("P")=""
Q 1
;
;=======================================================================
DISCHARG(DISA) ;Return true if there is a discharge.
N MVMNT,RETVAL
S MVMNT="",MVMNT=$O(^UTILITY("DGPM",$J,3,MVMNT))
I MVMNT D
. S DISA("A")=$P($G(^UTILITY("DGPM",$J,3,MVMNT,"A")),U,1)
. S DISA("P")=$P($G(^UTILITY("DGPM",$J,3,MVMNT,"P")),U,1)
E D
. S DISA("A")=$P(VAIP(17,1),U,1)
. I VAIP(17)=DGPMDA S DISA("P")=$P(DGPMP,U,1)
. E S DISA("P")=""
I DISA("A")>0 S RETVAL=1
E S RETVAL=0
Q RETVAL
;
;=======================================================================
SCANUPD(VSITBEG,VSITEND,INOUT) ;Scan range of visits and update
; input:
; VSITBEG := begin date
; VSITEND := end date
; INOUT := visit status
;
N VSIT,VSITDT,VSITIEN
S VSITDT=VSITBEG
F S VSITDT=$O(^TMP("VSITSTAT",$J,DFN,VSITDT)) Q:('VSITDT)!(VSITDT>VSITEND) D
. S VSITIEN="",VSITIEN=$O(^TMP("VSITSTAT",$J,DFN,VSITDT,VSITIEN))
. S VSIT("IEN")=VSITIEN
. S VSIT("IO")=INOUT
. S VSIT("SVC")=$$UPDSCAT(VSITIEN,INOUT)
. D UPD^VSIT
;
Q
;=======================================================================
UPDSCAT(VSITIEN,INOUT) ;Set the Service Category for in or outpatient.
N CSC,NSC
S (CSC,NSC)=$P($G(^AUPNVSIT(VSITIEN,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
;
VSITSTAT ;ISL/PKR - Visit Tracking in/out patient Update Protocol for ADT ;4/23/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996
+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 ;
EN ;Main entry point called by ADT event driver, process adm and d/c only.
+1 IF '$DATA(^UTILITY("DGPM",$JOB,1))&'$DATA(^UTILITY("DGPM",$JOB,3))
GOTO ENQ
+2 IF '$GET(DGQUIET)
WRITE !!,"Updating visit status..."
+3 ;
+4 NEW MAXDATE,TOFFSET
+5 SET MAXDATE=9999999
+6 SET TOFFSET=.0000001
+7 ;
+8 ;Build a time ordered list of visits for this patient.
+9 NEW DATE,TIME,VDT,VIEN
+10 SET VDT=""
+11 FOR
SET VDT=$ORDER(^AUPNVSIT("AA",DFN,VDT))
IF 'VDT
QUIT
Begin DoDot:1
+12 SET VIEN=""
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,VDT,VIEN))
+13 SET DATE=$PIECE(VDT,".",1)
+14 SET TIME=VDT-DATE
+15 SET DATE=MAXDATE-DATE+TIME
+16 SET ^TMP("VSITSTAT",$JOB,DFN,DATE,VIEN)=""
End DoDot:1
+17 ;
+18 ;Try to get information for the complete movement.
+19 SET VAIP("E")=DGPMDA
+20 DO IN5^VADPT
+21 ;
+22 ;Setup the admission information.
+23 NEW ADMA,ADMIT
+24 SET ADMIT=$$ADMISSIO(.ADMA)
+25 ;
+26 ;Setup the discharge information.
+27 NEW DISA,DISCHG
+28 SET DISCHG=$$DISCHARG(.DISA)
+29 ;
+30 ;We must have a value either for the admission after or previous.
+31 IF (ADMA("A")="")&(ADMA("P")="")
Begin DoDot:1
+32 WRITE !,"VSITSTAT FATAL ERROR -- NO ADMISSION TIME"
End DoDot:1
QUIT
+33 ;
+34 NEW IN,INOUT,OUT,SDBEG,SDEND
+35 SET IN=1
SET OUT=0
+36 ;
+37 ;General, this handles admission add and parts of admission change
+38 ;delete change.
+39 IF (+ADMA("A")>0)&(ADMA("A")'=ADMA("P"))
Begin DoDot:1
+40 SET SDBEG=ADMA("A")-TOFFSET
+41 IF DISCHG
SET SDEND=DISA("A")
+42 IF '$TEST
SET SDEND=MAXDATE
+43 SET INOUT=IN
+44 DO SCANUPD(SDBEG,SDEND,INOUT)
End DoDot:1
+45 ;
+46 ;Admission change. We only need to worry about a latter time. The
+47 ;earlier case is entirely handled above.
+48 IF (+ADMA("P")>0)&(+ADMA("P")<+ADMA("A"))
Begin DoDot:1
+49 SET SDBEG=ADMA("P")
+50 SET SDEND=ADMA("A")-TOFFSET
+51 SET INOUT=OUT
+52 DO SCANUPD(SDBEG,SDEND,INOUT)
End DoDot:1
+53 ;
+54 ;Admission delete.
+55 IF (+ADMA("P")>0)&(ADMA("A")="")
Begin DoDot:1
+56 SET SDBEG=ADMA("P")-TOFFSET
+57 IF +DISA("P")>0
SET SDEND=DISA("P")
+58 IF '$TEST
SET SDEND=MAXDATE
+59 SET INOUT=OUT
+60 DO SCANUPD(SDBEG,SDEND,INOUT)
End DoDot:1
+61 ;
+62 ;Discharge add.
+63 IF (ADMA("A")=ADMA("P"))&(+DISA("A")>0)
Begin DoDot:1
+64 SET SDBEG=DISA("A")+TOFFSET
+65 SET SDEND=MAXDATE
+66 SET INOUT=OUT
+67 DO SCANUPD(SDBEG,SDEND,INOUT)
End DoDot:1
+68 ;
+69 ;Discharge change. We only need to worry about an earlier discharge
+70 ;time.
+71 IF (+DISA("A")>0)&(+DISA("A")<+DISA("P"))
Begin DoDot:1
+72 SET SDBEG=DISA("A")+TOFFSET
+73 SET SDEND=DISA("P")
+74 SET INOUT=OUT
+75 DO SCANUPD(SDBEG,SDEND,INOUT)
End DoDot:1
+76 ;
+77 ;Discharge delete.
+78 IF (ADMA("A")=ADMA("P"))&(+DISA("P")>0)&(DISA("A")="")
Begin DoDot:1
+79 SET SDBEG=ADMA("A")-TOFFSET
+80 SET SDEND=DISA("P")
+81 SET INOUT=IN
+82 DO SCANUPD(SDBEG,SDEND,INOUT)
End DoDot:1
+83 ;
+84 IF '$GET(DGQUIET)
WRITE "completed."
+85 ;
ENQ ;
+1 KILL ^TMP("VSITSTAT",$JOB,DFN)
+2 DO KVA^VADPT
+3 QUIT
+4 ;
+5 ;=======================================================================
ADMISSIO(ADMA) ;Return true if there is an admission.
+1 ;
+2 ;If the movement is just a change in discharge time UTILITY(...1,...)
+3 ;will not exist.
+4 NEW MVMNT
+5 SET MVMNT=""
SET MVMNT=$ORDER(^UTILITY("DGPM",$JOB,1,MVMNT))
+6 IF MVMNT
Begin DoDot:1
+7 SET ADMA("A")=$PIECE($GET(^UTILITY("DGPM",$JOB,1,MVMNT,"A")),U,1)
+8 SET ADMA("P")=$PIECE($GET(^UTILITY("DGPM",$JOB,1,MVMNT,"P")),U,1)
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 SET ADMA("A")=$PIECE(VAIP(13,1),U,1)
+11 IF VAIP(13)=DGPMDA
SET ADMA("P")=$PIECE(DGPMP,U,1)
+12 IF '$TEST
SET ADMA("P")=""
End DoDot:1
+13 QUIT 1
+14 ;
+15 ;=======================================================================
DISCHARG(DISA) ;Return true if there is a discharge.
+1 NEW MVMNT,RETVAL
+2 SET MVMNT=""
SET MVMNT=$ORDER(^UTILITY("DGPM",$JOB,3,MVMNT))
+3 IF MVMNT
Begin DoDot:1
+4 SET DISA("A")=$PIECE($GET(^UTILITY("DGPM",$JOB,3,MVMNT,"A")),U,1)
+5 SET DISA("P")=$PIECE($GET(^UTILITY("DGPM",$JOB,3,MVMNT,"P")),U,1)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 SET DISA("A")=$PIECE(VAIP(17,1),U,1)
+8 IF VAIP(17)=DGPMDA
SET DISA("P")=$PIECE(DGPMP,U,1)
+9 IF '$TEST
SET DISA("P")=""
End DoDot:1
+10 IF DISA("A")>0
SET RETVAL=1
+11 IF '$TEST
SET RETVAL=0
+12 QUIT RETVAL
+13 ;
+14 ;=======================================================================
SCANUPD(VSITBEG,VSITEND,INOUT) ;Scan range of visits and update
+1 ; input:
+2 ; VSITBEG := begin date
+3 ; VSITEND := end date
+4 ; INOUT := visit status
+5 ;
+6 NEW VSIT,VSITDT,VSITIEN
+7 SET VSITDT=VSITBEG
+8 FOR
SET VSITDT=$ORDER(^TMP("VSITSTAT",$JOB,DFN,VSITDT))
IF ('VSITDT)!(VSITDT>VSITEND)
QUIT
Begin DoDot:1
+9 SET VSITIEN=""
SET VSITIEN=$ORDER(^TMP("VSITSTAT",$JOB,DFN,VSITDT,VSITIEN))
+10 SET VSIT("IEN")=VSITIEN
+11 SET VSIT("IO")=INOUT
+12 SET VSIT("SVC")=$$UPDSCAT(VSITIEN,INOUT)
+13 DO UPD^VSIT
End DoDot:1
+14 ;
+15 QUIT
+16 ;=======================================================================
UPDSCAT(VSITIEN,INOUT) ;Set the Service Category for in or outpatient.
+1 NEW CSC,NSC
+2 SET (CSC,NSC)=$PIECE($GET(^AUPNVSIT(VSITIEN,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 ;
