- SDSTAT ;MJK/ALB - Appt Status Update Protocol for ADT ; 7/14/92
- ;;5.3;Scheduling;**31,132,396,1015**;Aug 13, 1993;Build 21
- ;IHS/ANMC/LJF 12/05/2001 if in ADT quiet mode, set SD quiet mode
- ;
- 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)
- I $G(DGQUIET) NEW SDMODE S SDMODE=2 ;IHS/ANMC/LJF 12/5/2001
- 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
- SDSTAT ;MJK/ALB - Appt Status Update Protocol for ADT ; 7/14/92
- +1 ;;5.3;Scheduling;**31,132,396,1015**;Aug 13, 1993;Build 21
- +2 ;IHS/ANMC/LJF 12/05/2001 if in ADT quiet mode, set SD quiet mode
- +3 ;
- 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 ;IHS/ANMC/LJF 12/5/2001
- IF $GET(DGQUIET)
- NEW SDMODE
- SET SDMODE=2
- +6 IF '$GET(DGQUIET)
- WRITE !!,"Updating appointment status..."
- +7 SET ^TMP("SDSTAT",$JOB,0)=0
- SET ^TMP("SDOE STAT",$JOB,0)=0
- +8 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
- +9 SET PREV=$SELECT(+SDP:+SDP,1:9999999)
- SET AFTER=$SELECT(+SDA:+SDA,1:9999999)
- +10 ; d/c & same d/t then quit
- IF SDTYPE=3
- IF +SDP=+SDA
- QUIT
- +11 ; 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
- +12 ; adm -> same d/t & same ward then quit
- IF SDTYPE=1
- IF +SDP=+SDA
- IF $PIECE(SDP,U,6)=$PIECE(SDA,U,6)
- QUIT
- +13 ; 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)
- +14 SET SDBEG=$SELECT(PREV>AFTER:AFTER,1:PREV)
- SET SDEND=$SELECT(PREV>AFTER:PREV,1:AFTER)
- +15 DO SCAN(DFN,SDBEG,SDEND)
- QUIT
- End DoDot:1
- +16 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
