SDSTAT ;MJK/ALB - Appt Status Update Protocol for ADT ; 7/14/92
;;5.3;Scheduling;**31,132,396**;Aug 13, 1993
;
EN ; -- main entry point called by ADT event driver
; -- process adm and d/c only
I '$D(^UTILITY("DGPM",$J,1)),'$D(^(3)) G ENQ
I '$O(^DPT(DFN,"S",0)) G ENQ
N SDBEG,SDEND,PREV,AFTER,SDP,SDA,SDTYPE,SDCA K ^TMP("SDSTAT",$J),^TMP("SDOE STAT",$J)
W:'$G(DGQUIET) !!,"Updating appointment status..."
S ^TMP("SDSTAT",$J,0)=0,^TMP("SDOE STAT",$J,0)=0
F SDTYPE=1,3 S SDMVT="" F S SDMVT=$O(^UTILITY("DGPM",$J,SDTYPE,SDMVT)) Q:'SDMVT S SDP=$G(^(SDMVT,"P")),SDA=$G(^("A")) D
.S PREV=$S(+SDP:+SDP,1:9999999),AFTER=$S(+SDA:+SDA,1:9999999)
.I SDTYPE=3,+SDP=+SDA Q ; d/c & same d/t then quit
.I SDTYPE=3,$P($G(^DIC(42,+$P($G(^DGPM(+$P($S(SDP]"":SDP,1:SDA),U,14),0)),U,6),0)),U,3)="D" Q ; d/c & admitted to dom ward then quit
.I SDTYPE=1,+SDP=+SDA,$P(SDP,U,6)=$P(SDA,U,6) Q ; adm -> same d/t & same ward then quit
.I SDTYPE=1,+SDP=+SDA S PREV=+SDP,AFTER=$S(+$G(^DGPM(+$P(SDP,U,17),0)):+^(0),1:9999999) ; adm & same d/t then reset date range
.S SDBEG=$S(PREV>AFTER:AFTER,1:PREV),SDEND=$S(PREV>AFTER:PREV,1:AFTER)
.D SCAN(DFN,SDBEG,SDEND) Q
W:'$G(DGQUIET) "completed."
ENQ K ^TMP("SDSTAT",$J),^TMP("SDOE STAT",$J) Q
;
SCAN(SDFN,SDBEG,SDEND) ; -- scan range of appts to update
; input: SDFN := ien of patient
; SDBEG := begin date
; SDEND := end date
; ^TMP("SDSTAT",$J) := array of apts processed
; ^TMP("SDOE STAT",$J) := array of encounters processed
;
N SDT,SDOE,SDOEP,SDORG,SDSTB,SDSTA
; -- process appts
S SDT=SDBEG
F S SDT=$O(^DPT(SDFN,"S",SDT)) Q:'SDT!(SDT>SDEND) D
.I $D(^TMP("SDSTAT",$J,SDT)) Q ; appt already processed
.S ^TMP("SDSTAT",$J,0)=^TMP("SDSTAT",$J,0)+1,^(SDT)=""
.D UPDATE(SDFN,SDT)
;
; -- process encounters
S SDT=SDBEG
F S SDT=$O(^SCE("ADFN",SDFN,SDT)) Q:'SDT!(SDT>SDEND) D
.S SDOE=0 F S SDOE=$O(^SCE("ADFN",SDFN,SDT,SDOE)) Q:'SDOE D
..I $D(^TMP("SDOE STAT",$J,SDOE)) Q ; emcounter already processed
..S ^TMP("SDOE STAT",$J,0)=^TMP("SDOE STAT",$J,0)+1,^(SDOE)=""
..S SDOE0=$G(^SCE(SDOE,0)),SDORG=$P(SDOE0,U,8),SDOEP=$P(SDOE0,U,6)
..I SDOEP!(SDORG=1) Q
..S SDSTB=$S($P(SDOE0,U,12)=8:"I",1:""),SDSTA=$$INP^SDAM2(SDFN,SDT)
..N SDATA,SDADTHDL,DFN S SDADTHDL=$$HANDLE^SDAMEVT(SDORG),DFN=SDFN
..I SDORG=2 D BEFORE^SDAMEVT2(SDOE,SDADTHDL)
..I SDORG=3 D BEFORE^SDAMEVT3(SDFN,SDT,9,SDADTHDL)
..D OE(SDOE,SDSTB,SDSTA,SDADTHDL)
..I SDORG=2 D EVT^SDAMEVT2(SDOE,7,SDADTHDL)
..I SDORG=3 D EVT^SDAMEVT3(SDFN,SDT,9,SDADTHDL)
Q
;
UPDATE(DFN,SDT) ; -- update appt status
; input: DFN := ien of patient
; SDT := date of appt
;
N SDATA,SDSTB,SDSTA,SDSTB,SDOE,SDCL
G UPDATEQ:'$D(^DPT(DFN,"S",SDT,0)) S SDATA=^(0)
S SDOE=+$P(SDATA,U,20),SDSTB=$P(SDATA,U,2),SDCL=+SDATA
I SDSTB=""!(SDSTB="NT")!(SDSTB="I") S SDSTA=$$STAT() I SDSTB'=SDSTA D
.I $$REQ^SDM1A(SDT)="CI"!(SDT'<(DT+.2359)) S $P(^DPT(DFN,"S",SDT,0),U,2)=SDSTA Q
.I SDT<(DT+.2359) D
..N SDATA,SDADTHDL,SDOEC
..S SDOE=$S(SDOE:SDOE,1:+$$GETAPT^SDVSIT2(DFN,SDT,SDCL)) Q:'SDOE
..S SDADTHDL=$$HANDLE^SDAMEVT(+$P($G(^SCE(SDOE,0)),U,8))
..D OEVT^SDAMEVT(SDOE,"BEFORE",SDADTHDL,.SDATA)
..S $P(^DPT(DFN,"S",SDT,0),U,2)=SDSTA
..D OE(SDOE,SDSTB,SDSTA,SDADTHDL)
..D OEVT^SDAMEVT(SDOE,"AFTER",SDADTHDL,.SDATA)
..I SDSTA="I",$G(SDOE),$P($G(^SCE(SDOE,0)),U,12)=14 D
...S $P(^SCE(SDOE,0),U,12)=8
...S SDOEC=$O(^SCE("APAR",SDOE,SDOE)) I SDOEC S $P(^SCE(SDOEC,0),U,12)=8
UPDATEQ Q
;
STAT() ; -- determine status of appt
N C,X
S C=$G(^SC(+SDATA,"S",SDT,1,+$$FIND^SDAM2(DFN,SDT,+SDATA),"C"))
I $$INP^SDAM2(DFN,SDT)="I" S X="I" G STATQ ; inpatient
I SDT>(DT+.2359) S X="" G STATQ ; future
I $$REQ^SDM1A(.SDT)="CI",C S X="" G STATQ ; checked in
I $$COCMP^SDM1A(DFN,SDT),$P(C,U,3) S X="" G STATQ ; checked out
I '$$CHK^SDM1A(+SDATA,SDT) S X="" G STATQ ; non-count
S X="NT"
STATQ Q X
;
OE(SDOE,SDSTB,SDSTA,SDHDL) ; -- update outpatient encounter if appropriate
N Y
S Y=0
I 'Y,SDSTB="I",SDSTA="NT" S Y=1
I 'Y,SDSTB="I",SDSTA="" S Y=1
I 'Y,SDSTB="NT",SDSTA="I" S Y=1
I 'Y,SDSTB="",SDSTA="I" S Y=1
I Y D
.D COMDT^SDCODEL(SDOE,0)
.D EN^SDCOM(SDOE,0,SDHDL)
OEQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSTAT 4304 printed Dec 13, 2024@03:01:26 Page 2
SDSTAT ;MJK/ALB - Appt Status Update Protocol for ADT ; 7/14/92
+1 ;;5.3;Scheduling;**31,132,396**;Aug 13, 1993
+2 ;
EN ; -- main entry point called by ADT event driver
+1 ; -- process adm and d/c only
+2 IF '$DATA(^UTILITY("DGPM",$JOB,1))
IF '$DATA(^(3))
GOTO ENQ
+3 IF '$ORDER(^DPT(DFN,"S",0))
GOTO ENQ
+4 NEW SDBEG,SDEND,PREV,AFTER,SDP,SDA,SDTYPE,SDCA
KILL ^TMP("SDSTAT",$JOB),^TMP("SDOE STAT",$JOB)
+5 if '$GET(DGQUIET)
WRITE !!,"Updating appointment status..."
+6 SET ^TMP("SDSTAT",$JOB,0)=0
SET ^TMP("SDOE STAT",$JOB,0)=0
+7 FOR SDTYPE=1,3
SET SDMVT=""
FOR
SET SDMVT=$ORDER(^UTILITY("DGPM",$JOB,SDTYPE,SDMVT))
if 'SDMVT
QUIT
SET SDP=$GET(^(SDMVT,"P"))
SET SDA=$GET(^("A"))
Begin DoDot:1
+8 SET PREV=$SELECT(+SDP:+SDP,1:9999999)
SET AFTER=$SELECT(+SDA:+SDA,1:9999999)
+9 ; d/c & same d/t then quit
IF SDTYPE=3
IF +SDP=+SDA
QUIT
+10 ; d/c & admitted to dom ward then quit
IF SDTYPE=3
IF $PIECE($GET(^DIC(42,+$PIECE($GET(^DGPM(+$PIECE($SELECT(SDP]"":SDP,1:SDA),U,14),0)),U,6),0)),U,3)="D"
QUIT
+11 ; adm -> same d/t & same ward then quit
IF SDTYPE=1
IF +SDP=+SDA
IF $PIECE(SDP,U,6)=$PIECE(SDA,U,6)
QUIT
+12 ; adm & same d/t then reset date range
IF SDTYPE=1
IF +SDP=+SDA
SET PREV=+SDP
SET AFTER=$SELECT(+$GET(^DGPM(+$PIECE(SDP,U,17),0)):+^(0),1:9999999)
+13 SET SDBEG=$SELECT(PREV>AFTER:AFTER,1:PREV)
SET SDEND=$SELECT(PREV>AFTER:PREV,1:AFTER)
+14 DO SCAN(DFN,SDBEG,SDEND)
QUIT
End DoDot:1
+15 if '$GET(DGQUIET)
WRITE "completed."
ENQ KILL ^TMP("SDSTAT",$JOB),^TMP("SDOE STAT",$JOB)
QUIT
+1 ;
SCAN(SDFN,SDBEG,SDEND) ; -- scan range of appts to update
+1 ; input: SDFN := ien of patient
+2 ; SDBEG := begin date
+3 ; SDEND := end date
+4 ; ^TMP("SDSTAT",$J) := array of apts processed
+5 ; ^TMP("SDOE STAT",$J) := array of encounters processed
+6 ;
+7 NEW SDT,SDOE,SDOEP,SDORG,SDSTB,SDSTA
+8 ; -- process appts
+9 SET SDT=SDBEG
+10 FOR
SET SDT=$ORDER(^DPT(SDFN,"S",SDT))
if 'SDT!(SDT>SDEND)
QUIT
Begin DoDot:1
+11 ; appt already processed
IF $DATA(^TMP("SDSTAT",$JOB,SDT))
QUIT
+12 SET ^TMP("SDSTAT",$JOB,0)=^TMP("SDSTAT",$JOB,0)+1
SET ^(SDT)=""
+13 DO UPDATE(SDFN,SDT)
End DoDot:1
+14 ;
+15 ; -- process encounters
+16 SET SDT=SDBEG
+17 FOR
SET SDT=$ORDER(^SCE("ADFN",SDFN,SDT))
if 'SDT!(SDT>SDEND)
QUIT
Begin DoDot:1
+18 SET SDOE=0
FOR
SET SDOE=$ORDER(^SCE("ADFN",SDFN,SDT,SDOE))
if 'SDOE
QUIT
Begin DoDot:2
+19 ; emcounter already processed
IF $DATA(^TMP("SDOE STAT",$JOB,SDOE))
QUIT
+20 SET ^TMP("SDOE STAT",$JOB,0)=^TMP("SDOE STAT",$JOB,0)+1
SET ^(SDOE)=""
+21 SET SDOE0=$GET(^SCE(SDOE,0))
SET SDORG=$PIECE(SDOE0,U,8)
SET SDOEP=$PIECE(SDOE0,U,6)
+22 IF SDOEP!(SDORG=1)
QUIT
+23 SET SDSTB=$SELECT($PIECE(SDOE0,U,12)=8:"I",1:"")
SET SDSTA=$$INP^SDAM2(SDFN,SDT)
+24 NEW SDATA,SDADTHDL,DFN
SET SDADTHDL=$$HANDLE^SDAMEVT(SDORG)
SET DFN=SDFN
+25 IF SDORG=2
DO BEFORE^SDAMEVT2(SDOE,SDADTHDL)
+26 IF SDORG=3
DO BEFORE^SDAMEVT3(SDFN,SDT,9,SDADTHDL)
+27 DO OE(SDOE,SDSTB,SDSTA,SDADTHDL)
+28 IF SDORG=2
DO EVT^SDAMEVT2(SDOE,7,SDADTHDL)
+29 IF SDORG=3
DO EVT^SDAMEVT3(SDFN,SDT,9,SDADTHDL)
End DoDot:2
End DoDot:1
+30 QUIT
+31 ;
UPDATE(DFN,SDT) ; -- update appt status
+1 ; input: DFN := ien of patient
+2 ; SDT := date of appt
+3 ;
+4 NEW SDATA,SDSTB,SDSTA,SDSTB,SDOE,SDCL
+5 if '$DATA(^DPT(DFN,"S",SDT,0))
GOTO UPDATEQ
SET SDATA=^(0)
+6 SET SDOE=+$PIECE(SDATA,U,20)
SET SDSTB=$PIECE(SDATA,U,2)
SET SDCL=+SDATA
+7 IF SDSTB=""!(SDSTB="NT")!(SDSTB="I")
SET SDSTA=$$STAT()
IF SDSTB'=SDSTA
Begin DoDot:1
+8 IF $$REQ^SDM1A(SDT)="CI"!(SDT'<(DT+.2359))
SET $PIECE(^DPT(DFN,"S",SDT,0),U,2)=SDSTA
QUIT
+9 IF SDT<(DT+.2359)
Begin DoDot:2
+10 NEW SDATA,SDADTHDL,SDOEC
+11 SET SDOE=$SELECT(SDOE:SDOE,1:+$$GETAPT^SDVSIT2(DFN,SDT,SDCL))
if 'SDOE
QUIT
+12 SET SDADTHDL=$$HANDLE^SDAMEVT(+$PIECE($GET(^SCE(SDOE,0)),U,8))
+13 DO OEVT^SDAMEVT(SDOE,"BEFORE",SDADTHDL,.SDATA)
+14 SET $PIECE(^DPT(DFN,"S",SDT,0),U,2)=SDSTA
+15 DO OE(SDOE,SDSTB,SDSTA,SDADTHDL)
+16 DO OEVT^SDAMEVT(SDOE,"AFTER",SDADTHDL,.SDATA)
+17 IF SDSTA="I"
IF $GET(SDOE)
IF $PIECE($GET(^SCE(SDOE,0)),U,12)=14
Begin DoDot:3
+18 SET $PIECE(^SCE(SDOE,0),U,12)=8
+19 SET SDOEC=$ORDER(^SCE("APAR",SDOE,SDOE))
IF SDOEC
SET $PIECE(^SCE(SDOEC,0),U,12)=8
End DoDot:3
End DoDot:2
End DoDot:1
UPDATEQ QUIT
+1 ;
STAT() ; -- determine status of appt
+1 NEW C,X
+2 SET C=$GET(^SC(+SDATA,"S",SDT,1,+$$FIND^SDAM2(DFN,SDT,+SDATA),"C"))
+3 ; inpatient
IF $$INP^SDAM2(DFN,SDT)="I"
SET X="I"
GOTO STATQ
+4 ; future
IF SDT>(DT+.2359)
SET X=""
GOTO STATQ
+5 ; checked in
IF $$REQ^SDM1A(.SDT)="CI"
IF C
SET X=""
GOTO STATQ
+6 ; checked out
IF $$COCMP^SDM1A(DFN,SDT)
IF $PIECE(C,U,3)
SET X=""
GOTO STATQ
+7 ; non-count
IF '$$CHK^SDM1A(+SDATA,SDT)
SET X=""
GOTO STATQ
+8 SET X="NT"
STATQ QUIT X
+1 ;
OE(SDOE,SDSTB,SDSTA,SDHDL) ; -- update outpatient encounter if appropriate
+1 NEW Y
+2 SET Y=0
+3 IF 'Y
IF SDSTB="I"
IF SDSTA="NT"
SET Y=1
+4 IF 'Y
IF SDSTB="I"
IF SDSTA=""
SET Y=1
+5 IF 'Y
IF SDSTB="NT"
IF SDSTA="I"
SET Y=1
+6 IF 'Y
IF SDSTB=""
IF SDSTA="I"
SET Y=1
+7 IF Y
Begin DoDot:1
+8 DO COMDT^SDCODEL(SDOE,0)
+9 DO EN^SDCOM(SDOE,0,SDHDL)
End DoDot:1
OEQ QUIT
