SDRPA05 ;BP-OIFO/ESW - Evaluate appointment status for HL7 ; 9/10/04 9:34am
;;5.3;Scheduling;**290,333,349,376,491,1015**;AUG 13, 2003;Build 21
;Evaluation of the appointment status is done from the computed field to match the displayed/printed status in the appointment management
;SD/491 - MODIFIED $$SCHEDULE to cut off appointments considered as rescheduled by with the scheduled date<2250000
Q
;
STATUS(DFN,SDADT,SDCL,TODAY,SFD) ;
;Input:
; SDADT - Appt date/time
; SDCL - Clinic IEN
; SFD: - 0 - if called from scanning previous runs - update
; - 1 - if called from scanning 2.98
;Output:
; SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_SDCLL_U_SD8RD
; where:
; SDMSH -HL7 segment
; SD25 - Filler Status:
; P - Pending
; F - Final
; SD6 - Event Reason
; SD8 - Appt Type
; SD8RD - rescheduled date/time if SD8="RS"
; SDCO - check out date
; SDCLL - clinic IEN from matching encounter
;
N SD0,SDST,SD6,SD8,SD25,SDMSH,SDCO,SDSTAT,SD8S,SD8RD
S SDST=$$GET1^DIQ(2.98,SDADT_","_DFN_",",3,"I")
I SDST'="" I SDST'="NT"&(SDST'="I") D Q SDSTAT
.S SD25="F",SDCO="",SD8RD=""
.I SDST="C" S SD6="CC",SD8="",SDMSH="S15" D ;cancel by clinic
..S SD8S=$$SCHEDULE(DFN,SDCL,SDADT),SD8=$P(SD8S,U),SD8RD=$P(SD8S,U,2)
.I SDST="CA" S SD6="CC",SD8="ABK",SDMSH="S15" ;cancel bt clinic and auto rebook
.I SDST="PC" S SD6="CP",SD8="",SDMSH="S15" D ; cancel by patient
..S SD8S=$$SCHEDULE(DFN,SDCL,SDADT),SD8=$P(SD8S,U),SD8RD=$P(SD8S,U,2)
.I SDST="PCA" S SD6="CP",SD8="ABK",SDMSH="S15" ;cancel by patient and auto rebook
.I SDST="NA" S SD6="NS",SD8="ABK",SDMSH="S26" ;no show and auto rebook
.I SDST="N" S SD6="NS",SD8="",SDMSH="S26" ;no show
.;evaluate 'non-count'
.I $P($G(^SC(SDCL,0)),U,17)="Y" D
..I SD8="" S SD8="NC" Q
..I SD8="RS" S SD8="RSN"
.;
.S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD
;process all others
S SD0=^DPT(DFN,"S",SDADT,0)
; check out from OUTPAT ENCOUNTER
;N SCE S SCE=$P(SD0,"^",20) S SDCO="" I SCE>0 S SDCO=$P(^SCE(SCE,0),"^",7)
N SCE S SCE=$P(SD0,"^",20) S SDCO="" I SCE>0,$D(^SCE(SCE,0)) S SDCO=$P(^SCE(SCE,0),"^",7)
N SDSTATX,SDX3
S SDSTATX=$$STATUS^SDAM1(DFN,SDADT,SDCL,SD0) ;call to compute the status (VistA)
;SDSTATX=Appt status IFN in 409.63 ; status name ; print status ; check in ; check out
I SDCO="" S SDCO=$P(SDSTATX,";",5) ; check out from clinic if NULL
I SDCO'=""&(+SDSTATX'=12) D Q SDSTAT
.S SD6="CO",SD25="F",SD8="",SD8RD="",SDMSH=$S(SFD=0:"S14",1:"S12")
.I +SDSTATX=3 S SD8="AR" ; action required
.I +SDSTATX=8 S SD8="I" ;inpatient
.;I +SDSTATX=12 S SD8="NC" ;non-count excluded to be compared to possible encounter does not matter if check out
.I +SDSTATX=2 S SD8="O" ;outpatient
.S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD
I +SDSTATX=3 D Q SDSTAT
.S SD25="P",SDMSH="S12",SDCO="",SD8RD=""
.I $P(SDSTATX,";",4)'="" S SD6="CI",SD8="AR" ;check in/action required
.E S SD6="",SD8="NAT",SD8RD="" ;no action taken
.S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD
I +SDSTATX=8!(+SDSTATX=11) S SD25="P",SD8RD="" D Q SDSTAT
.I +SDSTATX=8 S SD6="",SD8="I",SDCO="",SDMSH="S12" ;inpatient
.I +SDSTATX=11 S SD6="",SD8="F",SDCO="",SDMSH="S12" ;future
.S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD
;
;process non-count (not checked out)
I +SDSTATX=12 N SDCLL S SDCLL="" D S:SD6'="COE" SDCLL=SDCL S SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_SDCLL Q SDSTAT
.S SD6="",SD8="NC",SDCO="",SDMSH="S12",SD25="P"
.I (SDADT\1)-(TODAY\1)>0 S SD6="",SD8="NCF",SD25="P" Q
.N SDADTC,SDSCE,SDADTCK S SDADTC=(SDADT\1)-1+.99,SDADTCK=SDADTC+1 F D Q:'SDSCE!(SD6="COE")
..S SDSCE=$$EXAE^SDOE(DFN,SDADTC,SDADTCK)
..I SDSCE>1 N SDDATA D GETGEN^SDOE(SDSCE,"SDDATA") D
...N SDCL0,SDCL1,SDCL2
...S SDCLL=$P(SDDATA(0),"^",4) I $P(^SC(SDCLL,0),"^",17)="Y" D Q
....S SDADTC=$P(^SCE(SDSCE,0),"^")+.000001 ;
...S SDCL0=$P(^SC(SDCL,0),"^",7)_$P(^SC(SDCL,0),"^",18)
...S SDCL2=$P(^SC(SDCLL,0),"^",7)_$P(^SC(SDCLL,0),"^",18)
...I SDCL0'=SDCL2 S SDADTC=$P(^SCE(SDSCE,0),"^")+.000001 Q
...; proceed if the same DSS IDs pairs
...S SDCO=$P(SDDATA(0),"^",7)
...I SDCO'="" S SD6="COE",SD25="F",SDMSH=$S(SFD=0:"S14",1:"S12") Q
...;encounter exists but not in final (chek out) status
...S SDADTC=$P(^SCE(SDSCE,0),"^")+.000001
.I SD6="COE" Q
.;check out by matching encounter
.E I ((TODAY\1)-(SDADT\1))>2 D ;give 2 days to update
..S SD6="NM",SD25="F",SDMSH=$S(SFD=0:"S14",1:0) ;no match, to be skipped
Q 0
;
SCHEDULE(DFN,SDCL,SDADT) ; Scheduling flag
; If the patient has another appointment created on the same day as the cancellation date of the canceled appt, and that
; appointment is created for a clinic with the same stop code then return "RS".
; If there is not another appointment made on the same day, return "".
N SDCDT,SDCLN S SDCDT=$$GET1^DIQ(2.98,SDADT_","_DFN_",",15,"I") ;cancellation date
Q:'SDCDT ""
N SDCDTI S SDCDTI=SDCDT\1
N SDRESCH S SDRESCH=""
;exclude the same appointments
N SDAPDT S SDAPDT="" F S SDAPDT=$O(^DPT("ASADM",SDCDTI,DFN,SDAPDT)) Q:SDAPDT="" I SDAPDT>3030000 I SDAPDT'=SDADT I $D(^DPT(DFN,"S",SDAPDT)) D Q:SDRESCH'=""
.S SDCLN=+$P(^DPT(DFN,"S",SDAPDT,0),U) I $P(^SC(SDCLN,0),"^",7)=$P(^SC(SDCL,0),"^",7) S SDRESCH="RS"_"^"_SDAPDT ;compare stop code pointers
S:SDRESCH="" SDRESCH="^" Q SDRESCH
SDRPA05 ;BP-OIFO/ESW - Evaluate appointment status for HL7 ; 9/10/04 9:34am
+1 ;;5.3;Scheduling;**290,333,349,376,491,1015**;AUG 13, 2003;Build 21
+2 ;Evaluation of the appointment status is done from the computed field to match the displayed/printed status in the appointment management
+3 ;SD/491 - MODIFIED $$SCHEDULE to cut off appointments considered as rescheduled by with the scheduled date<2250000
+4 QUIT
+5 ;
STATUS(DFN,SDADT,SDCL,TODAY,SFD) ;
+1 ;Input:
+2 ; SDADT - Appt date/time
+3 ; SDCL - Clinic IEN
+4 ; SFD: - 0 - if called from scanning previous runs - update
+5 ; - 1 - if called from scanning 2.98
+6 ;Output:
+7 ; SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_SDCLL_U_SD8RD
+8 ; where:
+9 ; SDMSH -HL7 segment
+10 ; SD25 - Filler Status:
+11 ; P - Pending
+12 ; F - Final
+13 ; SD6 - Event Reason
+14 ; SD8 - Appt Type
+15 ; SD8RD - rescheduled date/time if SD8="RS"
+16 ; SDCO - check out date
+17 ; SDCLL - clinic IEN from matching encounter
+18 ;
+19 NEW SD0,SDST,SD6,SD8,SD25,SDMSH,SDCO,SDSTAT,SD8S,SD8RD
+20 SET SDST=$$GET1^DIQ(2.98,SDADT_","_DFN_",",3,"I")
+21 IF SDST'=""
IF SDST'="NT"&(SDST'="I")
Begin DoDot:1
+22 SET SD25="F"
SET SDCO=""
SET SD8RD=""
+23 ;cancel by clinic
IF SDST="C"
SET SD6="CC"
SET SD8=""
SET SDMSH="S15"
Begin DoDot:2
+24 SET SD8S=$$SCHEDULE(DFN,SDCL,SDADT)
SET SD8=$PIECE(SD8S,U)
SET SD8RD=$PIECE(SD8S,U,2)
End DoDot:2
+25 ;cancel bt clinic and auto rebook
IF SDST="CA"
SET SD6="CC"
SET SD8="ABK"
SET SDMSH="S15"
+26 ; cancel by patient
IF SDST="PC"
SET SD6="CP"
SET SD8=""
SET SDMSH="S15"
Begin DoDot:2
+27 SET SD8S=$$SCHEDULE(DFN,SDCL,SDADT)
SET SD8=$PIECE(SD8S,U)
SET SD8RD=$PIECE(SD8S,U,2)
End DoDot:2
+28 ;cancel by patient and auto rebook
IF SDST="PCA"
SET SD6="CP"
SET SD8="ABK"
SET SDMSH="S15"
+29 ;no show and auto rebook
IF SDST="NA"
SET SD6="NS"
SET SD8="ABK"
SET SDMSH="S26"
+30 ;no show
IF SDST="N"
SET SD6="NS"
SET SD8=""
SET SDMSH="S26"
+31 ;evaluate 'non-count'
+32 IF $PIECE($GET(^SC(SDCL,0)),U,17)="Y"
Begin DoDot:2
+33 IF SD8=""
SET SD8="NC"
QUIT
+34 IF SD8="RS"
SET SD8="RSN"
End DoDot:2
+35 ;
+36 SET SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD
End DoDot:1
QUIT SDSTAT
+37 ;process all others
+38 SET SD0=^DPT(DFN,"S",SDADT,0)
+39 ; check out from OUTPAT ENCOUNTER
+40 ;N SCE S SCE=$P(SD0,"^",20) S SDCO="" I SCE>0 S SDCO=$P(^SCE(SCE,0),"^",7)
+41 NEW SCE
SET SCE=$PIECE(SD0,"^",20)
SET SDCO=""
IF SCE>0
IF $DATA(^SCE(SCE,0))
SET SDCO=$PIECE(^SCE(SCE,0),"^",7)
+42 NEW SDSTATX,SDX3
+43 ;call to compute the status (VistA)
SET SDSTATX=$$STATUS^SDAM1(DFN,SDADT,SDCL,SD0)
+44 ;SDSTATX=Appt status IFN in 409.63 ; status name ; print status ; check in ; check out
+45 ; check out from clinic if NULL
IF SDCO=""
SET SDCO=$PIECE(SDSTATX,";",5)
+46 IF SDCO'=""&(+SDSTATX'=12)
Begin DoDot:1
+47 SET SD6="CO"
SET SD25="F"
SET SD8=""
SET SD8RD=""
SET SDMSH=$SELECT(SFD=0:"S14",1:"S12")
+48 ; action required
IF +SDSTATX=3
SET SD8="AR"
+49 ;inpatient
IF +SDSTATX=8
SET SD8="I"
+50 ;I +SDSTATX=12 S SD8="NC" ;non-count excluded to be compared to possible encounter does not matter if check out
+51 ;outpatient
IF +SDSTATX=2
SET SD8="O"
+52 SET SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD
End DoDot:1
QUIT SDSTAT
+53 IF +SDSTATX=3
Begin DoDot:1
+54 SET SD25="P"
SET SDMSH="S12"
SET SDCO=""
SET SD8RD=""
+55 ;check in/action required
IF $PIECE(SDSTATX,";",4)'=""
SET SD6="CI"
SET SD8="AR"
+56 ;no action taken
IF '$TEST
SET SD6=""
SET SD8="NAT"
SET SD8RD=""
+57 SET SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD
End DoDot:1
QUIT SDSTAT
+58 IF +SDSTATX=8!(+SDSTATX=11)
SET SD25="P"
SET SD8RD=""
Begin DoDot:1
+59 ;inpatient
IF +SDSTATX=8
SET SD6=""
SET SD8="I"
SET SDCO=""
SET SDMSH="S12"
+60 ;future
IF +SDSTATX=11
SET SD6=""
SET SD8="F"
SET SDCO=""
SET SDMSH="S12"
+61 SET SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_U_SD8RD
End DoDot:1
QUIT SDSTAT
+62 ;
+63 ;process non-count (not checked out)
+64 IF +SDSTATX=12
NEW SDCLL
SET SDCLL=""
Begin DoDot:1
+65 SET SD6=""
SET SD8="NC"
SET SDCO=""
SET SDMSH="S12"
SET SD25="P"
+66 IF (SDADT\1)-(TODAY\1)>0
SET SD6=""
SET SD8="NCF"
SET SD25="P"
QUIT
+67 NEW SDADTC,SDSCE,SDADTCK
SET SDADTC=(SDADT\1)-1+.99
SET SDADTCK=SDADTC+1
FOR
Begin DoDot:2
+68 SET SDSCE=$$EXAE^SDOE(DFN,SDADTC,SDADTCK)
+69 IF SDSCE>1
NEW SDDATA
DO GETGEN^SDOE(SDSCE,"SDDATA")
Begin DoDot:3
+70 NEW SDCL0,SDCL1,SDCL2
+71 SET SDCLL=$PIECE(SDDATA(0),"^",4)
IF $PIECE(^SC(SDCLL,0),"^",17)="Y"
Begin DoDot:4
+72 ;
SET SDADTC=$PIECE(^SCE(SDSCE,0),"^")+.000001
End DoDot:4
QUIT
+73 SET SDCL0=$PIECE(^SC(SDCL,0),"^",7)_$PIECE(^SC(SDCL,0),"^",18)
+74 SET SDCL2=$PIECE(^SC(SDCLL,0),"^",7)_$PIECE(^SC(SDCLL,0),"^",18)
+75 IF SDCL0'=SDCL2
SET SDADTC=$PIECE(^SCE(SDSCE,0),"^")+.000001
QUIT
+76 ; proceed if the same DSS IDs pairs
+77 SET SDCO=$PIECE(SDDATA(0),"^",7)
+78 IF SDCO'=""
SET SD6="COE"
SET SD25="F"
SET SDMSH=$SELECT(SFD=0:"S14",1:"S12")
QUIT
+79 ;encounter exists but not in final (chek out) status
+80 SET SDADTC=$PIECE(^SCE(SDSCE,0),"^")+.000001
End DoDot:3
End DoDot:2
IF 'SDSCE!(SD6="COE")
QUIT
+81 IF SD6="COE"
QUIT
+82 ;check out by matching encounter
+83 ;give 2 days to update
IF '$TEST
IF ((TODAY\1)-(SDADT\1))>2
Begin DoDot:2
+84 ;no match, to be skipped
SET SD6="NM"
SET SD25="F"
SET SDMSH=$SELECT(SFD=0:"S14",1:0)
End DoDot:2
End DoDot:1
IF SD6'="COE"
SET SDCLL=SDCL
SET SDSTAT=SDMSH_U_SD25_U_SD6_U_SD8_U_SDCO_U_SDCLL
QUIT SDSTAT
+85 QUIT 0
+86 ;
SCHEDULE(DFN,SDCL,SDADT) ; Scheduling flag
+1 ; If the patient has another appointment created on the same day as the cancellation date of the canceled appt, and that
+2 ; appointment is created for a clinic with the same stop code then return "RS".
+3 ; If there is not another appointment made on the same day, return "".
+4 ;cancellation date
NEW SDCDT,SDCLN
SET SDCDT=$$GET1^DIQ(2.98,SDADT_","_DFN_",",15,"I")
+5 IF 'SDCDT
QUIT ""
+6 NEW SDCDTI
SET SDCDTI=SDCDT\1
+7 NEW SDRESCH
SET SDRESCH=""
+8 ;exclude the same appointments
+9 NEW SDAPDT
SET SDAPDT=""
FOR
SET SDAPDT=$ORDER(^DPT("ASADM",SDCDTI,DFN,SDAPDT))
IF SDAPDT=""
QUIT
IF SDAPDT>3030000
IF SDAPDT'=SDADT
IF $DATA(^DPT(DFN,"S",SDAPDT))
Begin DoDot:1
+10 ;compare stop code pointers
SET SDCLN=+$PIECE(^DPT(DFN,"S",SDAPDT,0),U)
IF $PIECE(^SC(SDCLN,0),"^",7)=$PIECE(^SC(SDCL,0),"^",7)
SET SDRESCH="RS"_"^"_SDAPDT
End DoDot:1
IF SDRESCH'=""
QUIT
+11 IF SDRESCH=""
SET SDRESCH="^"
QUIT SDRESCH
