- SDRPA05 ;BP-OIFO/ESW - Evaluate appointment status for HL7 ; 9/10/04 9:34am
- ;;5.3;Scheduling;**290,333,349,376,491**;AUG 13, 2003;Build 53
- ;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRPA05 5543 printed Mar 13, 2025@22:05:20 Page 2
- SDRPA05 ;BP-OIFO/ESW - Evaluate appointment status for HL7 ; 9/10/04 9:34am
- +1 ;;5.3;Scheduling;**290,333,349,376,491**;AUG 13, 2003;Build 53
- +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
