SDTMP08 ;MS/PB- VISTA SCHEDULING RPCS ;DEC 6, 2018
;;5.3;Scheduling;**704,859**;DEC 6, 2018;Build 10
;
Q
;
APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) ;Cancels appointment
;APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) external parameter tag is in SDEC
;SDECAPTID - (required) pointer to SDEC APPOINTMENT file
;SDECTYP - (required) appointment Status valid values:
; C=CANCELLED BY CLINIC
; PC=CANCELLED BY PATIENT
;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2)
;SDECNOT - (optional) text representing user note
;SDECDATE - (optional) Cancel Date/Time in external format; defaults to NOW
;SDUSER - (optional) User that cancelled appt; defaults to current user
;Returns error code in recordset field ERRORID
;
N SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECI,SDECZ,SDECERR
N SDECLOC,SDECLEN,SDECSCIEN,SDECSCIEN1
N SDECNOEV,SDECSC1,SDRET
N %DT,X,Y
S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol
S SDECSCIEN1=0
;
S SDECI=0
S SDECY="^TMP(""SDEC08"","_$J_",""APPDEL"")"
K @SDECY
S @SDECY@(SDECI)="T00020ERRORID"_$C(30)
S SDECI=SDECI+1
;validate SDEC APPOINTMENT pointer (required)
I '$D(^SDEC(409.84,+$G(SDECAPTID),0)) D ERR(SDECI,"SDEC08: Invalid Appointment ID") Q
;validate appointment status type (required)
S SDECTYP=$G(SDECTYP)
S SDECTYP=$S(SDECTYP="C":"C",SDECTYP="CANCELLED BY CLINIC":"C",SDECTYP="PC":"PC",SDECTYP="CANCELLED BY PATIENT":"PC",1:"")
I SDECTYP="" D ERR(SDECI,"SDEC08: Invalid status type") Q
;validate CANCELLATION REASON pointer (optional)
S SDECCR=$G(SDECCR)
I SDECCR'="" S SDECCR=$O(^SD(409.2,"B",$G(SDECCR),"")) ;859 - correct misspelling
;validate SDECNOT
S SDECNOT=$TR(SDECNOT,"^"," ") ;alb/sat 658 - strip out ^
;validate cancel date/time
S SDECDATE=$G(SDECDATE)
I SDECDATE'="" S %DT="T" S X=SDECDATE D ^%DT S SDECDATE=Y I Y=-1 S SDECDATE=""
I $G(SDECDATE)="" S SDECDATE=$$NOW^XLFDT
;validate user
S SDUSER=$G(SDUSER)
I SDUSER'="" I '$D(^VA(200,+SDUSER,0)) S SDUSER=""
I SDUSER="" S SDUSER=DUZ
;
;TSTART
;
;Delete APPOINTMENT entries
S SDECNOD=^SDEC(409.84,SDECAPTID,0)
S SDECPATID=$P(SDECNOD,U,5)
S SDECSTART=$P(SDECNOD,U)
;
;Lock SDEC node
L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") Q ;TROLLBACK Q
;cancel check-in if walk-in
I $P(SDECNOD,U,13)="y" D
.S SDRET=""
.D CHECKIN^SDEC25(.SDRET,SDECAPTID,"@")
;cancel SDEC APPOINTMENT record
D SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,1)
;
S SDECSC1=$P(SDECNOD,U,7) ;RESOURCEID
I SDECSC1]"",$D(^SDEC(409.831,SDECSC1,0)) D I +$G(SDECZ) S SDECERR=+SDECZ D ERR(SDECI,$P(SDECZ,U,2)) Q
. S SDECNOD=^SDEC(409.831,SDECSC1,0)
. S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION
. Q:'+SDECLOC
. S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I SDECSCIEN="" D I 'SDECZ Q ;Q:SDECZ
. . S SDECERR="SDEC08: Unable to find associated appointment for this patient. "
. . S SDECZ=1
. . I '$D(^SDEC(409.831,SDECSC1,20)) S SDECZ=0 Q
. . N SDEC1
. . S SDEC1=0
. . F S SDEC1=$O(^SDEC(409.831,SDECSC1,20,SDEC1)) Q:'+SDEC1 Q:SDECZ=0 D
. . . Q:'$D(^SDEC(409.831,SDECSC1,20,SDEC1,0))
. . . S SDECLOC=$P(^SDEC(409.831,SDECSC1,20,SDEC1,0),U)
. . . S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I +SDECSCIEN S SDECZ=0 Q
. S SDECERR="SDEC08: CANCEL^SDEC08 Returned "
. I SDECLOC']"" S SDECZ="0^Unable to find associated appointment for this patient." Q
. I '$D(^SC(SDECLOC,0)) S SDECZ="0^Unable to find associated appointment for this patient." Q
. S SDECNOD=$G(^SC(SDECLOC,"S",SDECSTART,1,+SDECSCIEN,0))
. I SDECNOD="" S SDECZ="0^Unable to find associated appointment for this patient." Q
. S SDECLEN=$P(SDECNOD,U,2)
. D APCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECAPTID,SDECLEN)
. Q:+$G(SDECZ)
. D AVUPDT(SDECLOC,SDECSTART,SDECLEN)
. D AR433D^SDECAR2(SDECAPTID)
. ;L
;
;TCOMMIT
L -^SDEC(409.84,SDECPATID)
S SDECI=SDECI+1
S @SDECY@(SDECI)=""_$C(30)
S SDECI=SDECI+1
S @SDECY@(SDECI)=$C(31)
Q
;
AVUPDT(SDECSCD,SDECSTART,SDECLEN) ;Update Clinic availability
;See SDCNP0
N HSI,I,S,SB,SD,SDDIF,SI,SL,SS,ST,STARTDAY,STR,X,Y
S (SD,S)=SDECSTART
S I=SDECSCD
Q:'$D(^SC(I,"ST",SD\1,1))
S SL=^SC(I,"SL"),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2)
S SL=SDECLEN
S S=^SC(I,"ST",SD\1,1),Y=SD#1-SB*100,ST=Y#1*SI\.6+(Y\1*SI),SS=SL*HSI/60
I Y'<1 F I=ST+ST:SDDIF S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" S S=$E(S,1,I)_Y_$E(S,I+2,999),SS=SS-1 Q:SS'>0
S ^SC(SDECSCD,"ST",SD\1,1)=S
Q
;
APCAN(SDECZ,SDECLOC,SDECDFN,SDECSD,SDECAPTID,SDECLEN) ;
;Cancel appointment for patient SDECDFN in clinic SDECSC1
;at time SDECSD
N SDECPNOD,SDECC,DA,DIE,DPTST,DR,%H
;save data into SDEC APPOINTMENT in case of un-cancel (status & appt length)
S SDECPNOD=^DPT(SDECPATID,"S",SDECSD,0)
S DPTST=$P(SDECPNOD,U,2)
S DIE=409.84
S DA=SDECAPTID
S DR=".17///"_DPTST_";"_".18///"_SDECLEN
D ^DIE
S SDECC("PAT")=SDECDFN
S SDECC("CLN")=SDECLOC
S SDECC("TYP")=SDECTYP
S SDECC("ADT")=SDECSD
S %H=$H D YMD^%DTC
S SDECC("CDT")=SDECDATE ;X+%
S SDECC("NOT")=SDECNOT
S:+SDECCR SDECC("CR")=SDECCR
S SDECC("USR")=SDUSER
;
S SDECZ=$$CANCEL(.SDECC)
Q
;
SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,SDF) ;cancel SDEC APPOINTMENT entry
;SDECAPTID - (required) pointer to SDEC APPOINTMENT file
;SDECTYP - (required) appointment Status valid values:
; C=CANCELLED BY CLINIC
; PC=CANCELLED BY PATIENT
;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2)
;SDECNOT - (optional) text representing user note
;SDECDATE - (optional) Cancel Date/Time in fm format; defaults to NOW) ;
;SDF - (optional) flags
; 1. called from GUI (update consult only if called from GUI)
; 2. called from cancel in SDAM (CAN^SDCNP0) (do not reopen appt)
;Cancel SDEC APPOINTMENT entry
N DFN,PROVIEN,Y
N SAVESTRT,SDAPTYP,SDCL,SDI,SDIEN,SDECIENS,SDECFDA,SDECMSG,SDECWP,SDRES,SDT ;alb/sat 651 add SAVESTRT and SDRES
S SDF=$G(SDF,0)
S DFN=$$GET1^DIQ(409.84,SDECAPTID_",",.05) ;alb/sat 658
S SDT=$$GET1^DIQ(409.84,SDECAPTID_",",.01,"I")
S SAVESTRT=$$GET1^DIQ(409.84,SDECAPTID_",",.01) ;alb/sat 651
S SDRES=$$GET1^DIQ(409.84,SDECAPTID_",",.07,"I") ;alb/sat 651
S SDECIENS=SDECAPTID_","
S SDECFDA(409.84,SDECIENS,.12)=$S($G(SDECDATE)'="":SDECDATE,1:$$NOW^XLFDT)
S SDECFDA(409.84,SDECIENS,.121)=$S($G(SDUSER)'="":SDUSER,1:DUZ)
S:$G(SDECCR)'="" SDECFDA(409.84,SDECIENS,.122)=SDECCR
S SDECFDA(409.84,SDECIENS,.17)=SDECTYP
K SDECMSG
D FILE^DIE("","SDECFDA","SDECMSG")
S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I")
;alb/sat 658 modification begin
S SDECNOT=$G(SDECNOT),SDECNOT=$E(SDECNOT,1,160)
I $L(SDECNOT)>2,'$E(SDF,2) K SDECFDA S SDECFDA(2.98,SDT_","_DFN_",",17)=SDECNOT D UPDATE^DIE("","SDECFDA")
;alb/sat 658 modification end
I $P(SDAPTYP,";",2)="GMR(123,",$E(SDF,1) D
.S SDCL=$$SDCL^SDECUTL(SDECAPTID)
.S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I")
.D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",2,SDECTYP,SDECNOT,SAVESTRT,SDRES) ;alb/sat 651 added SAVESTRT
I $P(SDAPTYP,";",2)="SDWL(409.3," D ;update EWL
.S DFN=$$GET1^DIQ(409.3,$P(SDAPTYP,";",1)_",",.01,"I")
.Q:DFN=""
.S SDIEN=0 F S SDIEN=$O(^SDWL(409.3,"B",DFN,SDIEN)) Q:SDIEN="" D
..I $$GET1^DIQ(409.3,SDIEN_",",13,"I")=SDT D
...K SDECFDA,SDECMSG,SDECWP
...;S SDIEN=$P(SDAPTYP,";",1)
...S SDECFDA(409.3,SDIEN_",",13)="@"
...S SDECFDA(409.3,SDIEN_",",13.1)="@"
...S SDECFDA(409.3,SDIEN_",",13.2)="@"
...S SDECFDA(409.3,SDIEN_",",13.3)="@"
...S SDECFDA(409.3,SDIEN_",",13.4)="@"
...S SDECFDA(409.3,SDIEN_",",13.5)="@"
...S SDECFDA(409.3,SDIEN_",",13.6)="@"
...S SDECFDA(409.3,SDIEN_",",13.7)="@"
...S SDECFDA(409.3,SDIEN_",",13.8)="@"
...D UPDATE^DIE("","SDECFDA")
...D:'$E(SDF,2) WLOPEN^SDECWL("","",SDIEN) ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0
I $P(SDAPTYP,";",2)="SDEC(409.85," D ;update APPT
.K SDECFDA,SDECMSG,SDECWP
.D:'$E(SDF,2) AROPEN^SDECAR("",SDECAPTID) ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0
.S SDIEN=$P(SDAPTYP,";",1)
.S SDECFDA(409.85,SDIEN_",",13)="@"
.S SDECFDA(409.85,SDIEN_",",13.1)="@"
.S SDECFDA(409.85,SDIEN_",",13.2)="@"
.S SDECFDA(409.85,SDIEN_",",13.3)="@"
.S SDECFDA(409.85,SDIEN_",",13.4)="@"
.S SDECFDA(409.85,SDIEN_",",13.5)="@"
.S SDECFDA(409.85,SDIEN_",",13.6)="@"
.S SDECFDA(409.85,SDIEN_",",13.7)="@"
.S SDECFDA(409.85,SDIEN_",",13.8)="@"
.D UPDATE^DIE("","SDECFDA")
Q
;
CANEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CANCEL APPOINTMENT event
;when appointments cancelled via PIMS interface.
;Propagates cancellation to SDECAPPT and raises refresh event to running GUI clients
N SDECFOUND,SDECRES
Q:+$G(SDECNOEV)
Q:'+$G(SDECSC)
S SDECFOUND=0
I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CANEVT1(SDECRES,SDECSTART,SDECPAT)
I SDECFOUND D CANEVT3(SDECRES) Q
Q
;
CANEVT1(SDECRES,SDECSTART,SDECPAT) ;
;Get appointment id in SDECAPT
;If found, call SDECCAN(SDECAPPT) and return 1
;else return 0
N SDECFOUND,SDECAPPT
S SDECFOUND=0
Q:'+SDECRES SDECFOUND
Q:'$D(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART)) SDECFOUND
S SDECAPPT=0 F S SDECAPPT=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT)) Q:'+SDECAPPT D Q:SDECFOUND
. S SDECNOD=$G(^SDEC(409.84,SDECAPPT,0)) Q:SDECNOD=""
. I $P(SDECNOD,U,5)=SDECPAT,$P(SDECNOD,U,12)="" S SDECFOUND=1 Q
I SDECFOUND,+$G(SDECAPPT) D SDECCAN(SDECAPPT,,,,,,1)
Q SDECFOUND
;
CANEVT3(SDECRES) ;
;Call RaiseEvent to notify GUI clients
;
Q
N SDECRESN
S SDECRESN=$G(^SDEC(409.831,SDECRES,0))
Q:SDECRESN=""
S SDECRESN=$P(SDECRESN,"^")
;D EVENT^SDEC23("SCHEDULE-"_SDECRESN,"","","")
;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN)
Q
;
CANCEL(BSDR) ;EP; called to cancel appt
;
; Make call using: S ERR=$$CANCEL^SDEC08(.ARRAY)
;
; Input Array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
; BSDR("ADT") = appointment date and time
; BSDR("CDT") = cancel date and time
; BSDR("USR") = user who canceled appt
; BSDR("CR") = cancel reason - pointer to file 409.2
; BSDR("NOT") = cancel remarks - optional notes to 160 characters
;
;Output: error status and message
; = 0 or null: everything okay
; = 1^message: error and reason
;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
;
NEW IEN,DIE,DA,DR,SDMODE
S IEN=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
;
I $$CI^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until check-in deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
;
; remember before status
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
;
; get user who made appt and date appt made from ^SC
; because data in ^SC will be deleted
NEW USER,DATE
S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
;
; update file 2 info
NEW DIE,DA,DR
N SDFDA,SDIEN,SDMSG
S SDFDA="SDFDA(2.98,SDT_"",""_DFN_"","")"
S @SDFDA@(3)=BSDR("TYP")
S @SDFDA@(14)=BSDR("USR")
S @SDFDA@(15)=BSDR("CDT")
S:+$G(BSDR("CR")) @SDFDA@(16)=BSDR("CR")
S:$G(BSDR("NOT"))]"" @SDFDA@(17)=$E(BSDR("NOT"),1,160)
S @SDFDA@(19)=USER
S @SDFDA@(20)=DATE
D UPDATE^DIE("","SDFDA")
S DUZ=$G(MSGARY("DUZ"))
S:$G(DUZ(2))="" DUZ=$$KSP^XUPARAM("SITE")
N SDPCE
S SDPCE=$P($G(^DPT(DFN,"S",SDT,0)),U,20)
D:+SDPCE EN^SDCODEL(SDPCE,0) ;remove OUTPATIENT ENCOUNTER link
;
; delete data in ^SC
NEW DIK,DA
S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
D ^DIK
; call event driver
S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
;D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
Q 0
;
UNDOCANA(SDECY,SDECAPTID) ;Undo Cancel Appointment
;UNDOCANA(SDECY,SDECAPTID) external parameter tag in SDEC
;called by SDEC UNCANCEL APPT
; SDECAPTID = ien of appointment in SDEC APPOINTMENT (^SDECAPPT) file 409.84
N SDECDAM,SDECDEC,SDECI,SDECNOD,SDECPATID,SDECSTART
S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol ;is this used?
;
S SDECI=0
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
S ^TMP("SDEC",$J,SDECI)="T00020ERRORID"_$C(30)
;TSTART
;I '+SDECAPTID TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID.") Q
I '+SDECAPTID D ERR(SDECI+1,"Invalid Appointment ID.") Q
;I '$D(^SDEC(409.84,SDECAPTID,0)) TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID") Q
I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR(SDECI+1,"Invalid Appointment ID") Q
;Make sure appointment is cancelled
;I $$GET1^DIQ(409.84,SDECAPTID_",",.12)="" TROLLBACK D ERR(SDECI+1,"Appointment is not Cancelled.") Q
I $$GET1^DIQ(409.84,SDECAPTID_",",.12)="" D ERR(SDECI+1,"Appointment is not Cancelled.") Q
S SDECNOD=^SDEC(409.84,SDECAPTID,0)
;appts cancelled by patient cannot be un-cancelled. /* removed 9/17/2010 */
;I $P(^DPT($P(SDECNOD,U,5),"S",$P(SDECNOD,U,1),0),U,2)="PC" TROLLBACK D ERR(SDECI+1,"Cancelled by patient appointment cannot be uncancelled.") Q
;get appointment data
S SDECNOD=^SDEC(409.84,SDECAPTID,0)
S SDECDAM=$P(SDECNOD,U,9) ;date appt made
S SDECDEC=$P(SDECNOD,U,8) ;data entry clerk
S SDECLEN=$P(SDECNOD,U,18) ;length of appt in minutes
S SDECNOTE=$G(^SDEC(409.84,SDECAPTID,1,1,0)) ;note from SDEC APPOINTMENT
S SDECPATID=$P(SDECNOD,U,5) ;pointer to VA PATIENT file 2
S SDECSC1=$P($G(SDECNOD),U,7) ;resource
S SDECSTART=$P(SDECNOD,U) ;appt start time
S SDECWKIN=$P($G(SDECNOD),U,13) ;walk-in
;lock SDEC node
;L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") TROLLBACK Q
L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") Q
;un-cancel SDEC APPOINTMENT
D SDECUCAN(SDECAPTID)
I SDECSC1]"",$D(^SDEC(409.831,SDECSC1,0)) D I +$G(SDECZ) S SDECERR=SDECERR_$P(SDECZ,U,2) D ERR(SDECI,SDECERR) Q
. S SDECLOC=""
. S SDECNOD=^SDEC(409.831,SDECSC1,0)
. S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION ;support for single HOSPITAL LOCATION in SDEC RESOURCE
. I SDECLOC="" S SDECLOC=$$SDCL^SDECUTL(SDECAPTID) ;HOSPITAL LOCATION
. Q:'+SDECLOC
. ;un-cancel patient appointment and re-instate clinic appointment
. S SDECZ=""
. D APUCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECSC1,SDECWKIN)
;TCOMMIT
L -^SDEC(409.84,SDECPATID)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=""_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
SDECUCAN(SDECAPTID) ;called internally to update SDEC APPOINTMENT by clearing cancel date/time
N PROVIEN,SDAPTYP,SDCL,SDRES
S SDECIENS=SDECAPTID_","
S SDECFDA(409.84,SDECIENS,.12)=""
K SDECMSG
D FILE^DIE("","SDECFDA","SDECMSG")
S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I")
I $P(SDAPTYP,";",2)="GMR(123," D
.S SDCL=$$SDCL^SDECUTL(SDECAPTID)
.S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I")
.D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",1)
Q
;
APUCAN(SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECRES,SDECWKIN) ;
;un-Cancel appointment for patient SDECDFN in clinic SDECSC1
; SDECLOC = pointer to hospital location ^SC file 44
; SDECPATID = pointer to VA Patient ^DPT file 2
; SDECSTART = Appointment time
; SDECDAM = Date appointment made in FM format
; SDECDEC = Data entry clerk - pointer to NEW PERSON file 200
N SDECC,%H
S SDECC("PAT")=SDECPATID
S SDECC("CLN")=SDECLOC
S SDECC("ADT")=SDECSTART
S SDECC("NOTE")=SDECNOTE ;user note
S SDECC("RES")=SDECRES
S SDECC("USR")=DUZ
S SDECC("LEN")=SDECLEN
S SDECC("WKIN")=SDECWKIN
;
S SDECZ=$$UNCANCEL(.SDECC)
Q
;
UNCANCEL(BSDR) ;PEP; called to un-cancel appt
;
; Make call using: S ERR=$$UNCANCEL(.ARRAY)
;
; Input Array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("ADT") = appointment date and time
; BSDR("USR") = user who un-canceled appt
; BSDR("NOTE") = appointment note from SDEC APPOINTMENT
; BSDR("LEN") = appt length in minutes (numeric)
; BSDR("RES") = resource
; BSDR("WKIN")= walk-in
;
;Output: error status and message
; = 0 or null: everything okay
; = 1^message: error and reason
;
N DPTNOD,DPTNODR
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
;
S SDECERR=$$APPVISTA^SDEC07B(BSDR("LEN"),BSDR("NOTE"),BSDR("PAT"),BSDR("RES"),BSDR("ADT"),BSDR("WKIN"),BSDR("CLN"),.SDECI) ;alb/sat 665 APPVISTA moved to SDEC07B
Q SDECERR
;
ERR(SDECI,SDECERR) ;Error processing
S SDECI=SDECI+1
S SDECERR=$TR(SDECERR,"^","~")
;TROLLBACK
S ^TMP("SDEC",$J,SDECI)=SDECERR_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
ETRAP ;EP Error trap entry
D ^%ZTER
I '$D(SDECI) N SDECI S SDECI=999999
S SDECI=SDECI+1
D ERR(SDECI,"SDEC08 Error")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDTMP08 18531 printed Sep 23, 2025@20:38:19 Page 2
SDTMP08 ;MS/PB- VISTA SCHEDULING RPCS ;DEC 6, 2018
+1 ;;5.3;Scheduling;**704,859**;DEC 6, 2018;Build 10
+2 ;
+3 QUIT
+4 ;
APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) ;Cancels appointment
+1 ;APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) external parameter tag is in SDEC
+2 ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file
+3 ;SDECTYP - (required) appointment Status valid values:
+4 ; C=CANCELLED BY CLINIC
+5 ; PC=CANCELLED BY PATIENT
+6 ;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2)
+7 ;SDECNOT - (optional) text representing user note
+8 ;SDECDATE - (optional) Cancel Date/Time in external format; defaults to NOW
+9 ;SDUSER - (optional) User that cancelled appt; defaults to current user
+10 ;Returns error code in recordset field ERRORID
+11 ;
+12 NEW SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECI,SDECZ,SDECERR
+13 NEW SDECLOC,SDECLEN,SDECSCIEN,SDECSCIEN1
+14 NEW SDECNOEV,SDECSC1,SDRET
+15 NEW %DT,X,Y
+16 ;Don't execute SDEC CANCEL APPOINTMENT protocol
SET SDECNOEV=1
+17 SET SDECSCIEN1=0
+18 ;
+19 SET SDECI=0
+20 SET SDECY="^TMP(""SDEC08"","_$JOB_",""APPDEL"")"
+21 KILL @SDECY
+22 SET @SDECY@(SDECI)="T00020ERRORID"_$CHAR(30)
+23 SET SDECI=SDECI+1
+24 ;validate SDEC APPOINTMENT pointer (required)
+25 IF '$DATA(^SDEC(409.84,+$GET(SDECAPTID),0))
DO ERR(SDECI,"SDEC08: Invalid Appointment ID")
QUIT
+26 ;validate appointment status type (required)
+27 SET SDECTYP=$GET(SDECTYP)
+28 SET SDECTYP=$SELECT(SDECTYP="C":"C",SDECTYP="CANCELLED BY CLINIC":"C",SDECTYP="PC":"PC",SDECTYP="CANCELLED BY PATIENT":"PC",1:"")
+29 IF SDECTYP=""
DO ERR(SDECI,"SDEC08: Invalid status type")
QUIT
+30 ;validate CANCELLATION REASON pointer (optional)
+31 SET SDECCR=$GET(SDECCR)
+32 ;859 - correct misspelling
IF SDECCR'=""
SET SDECCR=$ORDER(^SD(409.2,"B",$GET(SDECCR),""))
+33 ;validate SDECNOT
+34 ;alb/sat 658 - strip out ^
SET SDECNOT=$TRANSLATE(SDECNOT,"^"," ")
+35 ;validate cancel date/time
+36 SET SDECDATE=$GET(SDECDATE)
+37 IF SDECDATE'=""
SET %DT="T"
SET X=SDECDATE
DO ^%DT
SET SDECDATE=Y
IF Y=-1
SET SDECDATE=""
+38 IF $GET(SDECDATE)=""
SET SDECDATE=$$NOW^XLFDT
+39 ;validate user
+40 SET SDUSER=$GET(SDUSER)
+41 IF SDUSER'=""
IF '$DATA(^VA(200,+SDUSER,0))
SET SDUSER=""
+42 IF SDUSER=""
SET SDUSER=DUZ
+43 ;
+44 ;TSTART
+45 ;
+46 ;Delete APPOINTMENT entries
+47 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+48 SET SDECPATID=$PIECE(SDECNOD,U,5)
+49 SET SDECSTART=$PIECE(SDECNOD,U)
+50 ;
+51 ;Lock SDEC node
+52 ;TROLLBACK Q
LOCK +^SDEC(409.84,SDECPATID):5
IF '$TEST
DO ERR(SDECI+1,"Another user is working with this patient's record. Please try again later")
QUIT
+53 ;cancel check-in if walk-in
+54 IF $PIECE(SDECNOD,U,13)="y"
Begin DoDot:1
+55 SET SDRET=""
+56 DO CHECKIN^SDEC25(.SDRET,SDECAPTID,"@")
End DoDot:1
+57 ;cancel SDEC APPOINTMENT record
+58 DO SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,1)
+59 ;
+60 ;RESOURCEID
SET SDECSC1=$PIECE(SDECNOD,U,7)
+61 IF SDECSC1]""
IF $DATA(^SDEC(409.831,SDECSC1,0))
Begin DoDot:1
+62 SET SDECNOD=^SDEC(409.831,SDECSC1,0)
+63 ;HOSPITAL LOCATION
SET SDECLOC=$PIECE(SDECNOD,U,4)
+64 if '+SDECLOC
QUIT
+65 ;Q:SDECZ
SET SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART)
IF SDECSCIEN=""
Begin DoDot:2
+66 SET SDECERR="SDEC08: Unable to find associated appointment for this patient. "
+67 SET SDECZ=1
+68 IF '$DATA(^SDEC(409.831,SDECSC1,20))
SET SDECZ=0
QUIT
+69 NEW SDEC1
+70 SET SDEC1=0
+71 FOR
SET SDEC1=$ORDER(^SDEC(409.831,SDECSC1,20,SDEC1))
if '+SDEC1
QUIT
if SDECZ=0
QUIT
Begin DoDot:3
+72 if '$DATA(^SDEC(409.831,SDECSC1,20,SDEC1,0))
QUIT
+73 SET SDECLOC=$PIECE(^SDEC(409.831,SDECSC1,20,SDEC1,0),U)
+74 SET SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART)
IF +SDECSCIEN
SET SDECZ=0
QUIT
End DoDot:3
End DoDot:2
IF 'SDECZ
QUIT
+75 SET SDECERR="SDEC08: CANCEL^SDEC08 Returned "
+76 IF SDECLOC']""
SET SDECZ="0^Unable to find associated appointment for this patient."
QUIT
+77 IF '$DATA(^SC(SDECLOC,0))
SET SDECZ="0^Unable to find associated appointment for this patient."
QUIT
+78 SET SDECNOD=$GET(^SC(SDECLOC,"S",SDECSTART,1,+SDECSCIEN,0))
+79 IF SDECNOD=""
SET SDECZ="0^Unable to find associated appointment for this patient."
QUIT
+80 SET SDECLEN=$PIECE(SDECNOD,U,2)
+81 DO APCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECAPTID,SDECLEN)
+82 if +$GET(SDECZ)
QUIT
+83 DO AVUPDT(SDECLOC,SDECSTART,SDECLEN)
+84 DO AR433D^SDECAR2(SDECAPTID)
+85 ;L
End DoDot:1
IF +$GET(SDECZ)
SET SDECERR=+SDECZ
DO ERR(SDECI,$PIECE(SDECZ,U,2))
QUIT
+86 ;
+87 ;TCOMMIT
+88 LOCK -^SDEC(409.84,SDECPATID)
+89 SET SDECI=SDECI+1
+90 SET @SDECY@(SDECI)=""_$CHAR(30)
+91 SET SDECI=SDECI+1
+92 SET @SDECY@(SDECI)=$CHAR(31)
+93 QUIT
+94 ;
AVUPDT(SDECSCD,SDECSTART,SDECLEN) ;Update Clinic availability
+1 ;See SDCNP0
+2 NEW HSI,I,S,SB,SD,SDDIF,SI,SL,SS,ST,STARTDAY,STR,X,Y
+3 SET (SD,S)=SDECSTART
+4 SET I=SDECSCD
+5 if '$DATA(^SC(I,"ST",SD\1,1))
QUIT
+6 SET SL=^SC(I,"SL")
SET X=$PIECE(SL,U,3)
SET STARTDAY=$SELECT($LENGTH(X):X,1:8)
SET SB=STARTDAY-1/100
SET X=$PIECE(SL,U,6)
SET HSI=$SELECT(X:X,1:4)
SET SI=$SELECT(X="":4,X<3:4,X:X,1:4)
SET STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
SET SDDIF=$SELECT(HSI<3:8/HSI,1:2)
+7 SET SL=SDECLEN
+8 SET S=^SC(I,"ST",SD\1,1)
SET Y=SD#1-SB*100
SET ST=Y#1*SI\.6+(Y\1*SI)
SET SS=SL*HSI/60
+9 IF Y'<1
FOR I=ST+ST:SDDIF
SET Y=$EXTRACT(STR,$FIND(STR,$EXTRACT(S,I+1)))
if Y=""
QUIT
SET S=$EXTRACT(S,1,I)_Y_$EXTRACT(S,I+2,999)
SET SS=SS-1
if SS'>0
QUIT
+10 SET ^SC(SDECSCD,"ST",SD\1,1)=S
+11 QUIT
+12 ;
APCAN(SDECZ,SDECLOC,SDECDFN,SDECSD,SDECAPTID,SDECLEN) ;
+1 ;Cancel appointment for patient SDECDFN in clinic SDECSC1
+2 ;at time SDECSD
+3 NEW SDECPNOD,SDECC,DA,DIE,DPTST,DR,%H
+4 ;save data into SDEC APPOINTMENT in case of un-cancel (status & appt length)
+5 SET SDECPNOD=^DPT(SDECPATID,"S",SDECSD,0)
+6 SET DPTST=$PIECE(SDECPNOD,U,2)
+7 SET DIE=409.84
+8 SET DA=SDECAPTID
+9 SET DR=".17///"_DPTST_";"_".18///"_SDECLEN
+10 DO ^DIE
+11 SET SDECC("PAT")=SDECDFN
+12 SET SDECC("CLN")=SDECLOC
+13 SET SDECC("TYP")=SDECTYP
+14 SET SDECC("ADT")=SDECSD
+15 SET %H=$HOROLOG
DO YMD^%DTC
+16 ;X+%
SET SDECC("CDT")=SDECDATE
+17 SET SDECC("NOT")=SDECNOT
+18 if +SDECCR
SET SDECC("CR")=SDECCR
+19 SET SDECC("USR")=SDUSER
+20 ;
+21 SET SDECZ=$$CANCEL(.SDECC)
+22 QUIT
+23 ;
SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,SDF) ;cancel SDEC APPOINTMENT entry
+1 ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file
+2 ;SDECTYP - (required) appointment Status valid values:
+3 ; C=CANCELLED BY CLINIC
+4 ; PC=CANCELLED BY PATIENT
+5 ;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2)
+6 ;SDECNOT - (optional) text representing user note
+7 ;SDECDATE - (optional) Cancel Date/Time in fm format; defaults to NOW) ;
+8 ;SDF - (optional) flags
+9 ; 1. called from GUI (update consult only if called from GUI)
+10 ; 2. called from cancel in SDAM (CAN^SDCNP0) (do not reopen appt)
+11 ;Cancel SDEC APPOINTMENT entry
+12 NEW DFN,PROVIEN,Y
+13 ;alb/sat 651 add SAVESTRT and SDRES
NEW SAVESTRT,SDAPTYP,SDCL,SDI,SDIEN,SDECIENS,SDECFDA,SDECMSG,SDECWP,SDRES,SDT
+14 SET SDF=$GET(SDF,0)
+15 ;alb/sat 658
SET DFN=$$GET1^DIQ(409.84,SDECAPTID_",",.05)
+16 SET SDT=$$GET1^DIQ(409.84,SDECAPTID_",",.01,"I")
+17 ;alb/sat 651
SET SAVESTRT=$$GET1^DIQ(409.84,SDECAPTID_",",.01)
+18 ;alb/sat 651
SET SDRES=$$GET1^DIQ(409.84,SDECAPTID_",",.07,"I")
+19 SET SDECIENS=SDECAPTID_","
+20 SET SDECFDA(409.84,SDECIENS,.12)=$SELECT($GET(SDECDATE)'="":SDECDATE,1:$$NOW^XLFDT)
+21 SET SDECFDA(409.84,SDECIENS,.121)=$SELECT($GET(SDUSER)'="":SDUSER,1:DUZ)
+22 if $GET(SDECCR)'=""
SET SDECFDA(409.84,SDECIENS,.122)=SDECCR
+23 SET SDECFDA(409.84,SDECIENS,.17)=SDECTYP
+24 KILL SDECMSG
+25 DO FILE^DIE("","SDECFDA","SDECMSG")
+26 SET SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I")
+27 ;alb/sat 658 modification begin
+28 SET SDECNOT=$GET(SDECNOT)
SET SDECNOT=$EXTRACT(SDECNOT,1,160)
+29 IF $LENGTH(SDECNOT)>2
IF '$EXTRACT(SDF,2)
KILL SDECFDA
SET SDECFDA(2.98,SDT_","_DFN_",",17)=SDECNOT
DO UPDATE^DIE("","SDECFDA")
+30 ;alb/sat 658 modification end
+31 IF $PIECE(SDAPTYP,";",2)="GMR(123,"
IF $EXTRACT(SDF,1)
Begin DoDot:1
+32 SET SDCL=$$SDCL^SDECUTL(SDECAPTID)
+33 SET PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I")
+34 ;alb/sat 651 added SAVESTRT
DO REQSET^SDEC07A($PIECE(SDAPTYP,";",1),PROVIEN,"",2,SDECTYP,SDECNOT,SAVESTRT,SDRES)
End DoDot:1
+35 ;update EWL
IF $PIECE(SDAPTYP,";",2)="SDWL(409.3,"
Begin DoDot:1
+36 SET DFN=$$GET1^DIQ(409.3,$PIECE(SDAPTYP,";",1)_",",.01,"I")
+37 if DFN=""
QUIT
+38 SET SDIEN=0
FOR
SET SDIEN=$ORDER(^SDWL(409.3,"B",DFN,SDIEN))
if SDIEN=""
QUIT
Begin DoDot:2
+39 IF $$GET1^DIQ(409.3,SDIEN_",",13,"I")=SDT
Begin DoDot:3
+40 KILL SDECFDA,SDECMSG,SDECWP
+41 ;S SDIEN=$P(SDAPTYP,";",1)
+42 SET SDECFDA(409.3,SDIEN_",",13)="@"
+43 SET SDECFDA(409.3,SDIEN_",",13.1)="@"
+44 SET SDECFDA(409.3,SDIEN_",",13.2)="@"
+45 SET SDECFDA(409.3,SDIEN_",",13.3)="@"
+46 SET SDECFDA(409.3,SDIEN_",",13.4)="@"
+47 SET SDECFDA(409.3,SDIEN_",",13.5)="@"
+48 SET SDECFDA(409.3,SDIEN_",",13.6)="@"
+49 SET SDECFDA(409.3,SDIEN_",",13.7)="@"
+50 SET SDECFDA(409.3,SDIEN_",",13.8)="@"
+51 DO UPDATE^DIE("","SDECFDA")
+52 ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0
if '$EXTRACT(SDF,2)
DO WLOPEN^SDECWL("","",SDIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+53 ;update APPT
IF $PIECE(SDAPTYP,";",2)="SDEC(409.85,"
Begin DoDot:1
+54 KILL SDECFDA,SDECMSG,SDECWP
+55 ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0
if '$EXTRACT(SDF,2)
DO AROPEN^SDECAR("",SDECAPTID)
+56 SET SDIEN=$PIECE(SDAPTYP,";",1)
+57 SET SDECFDA(409.85,SDIEN_",",13)="@"
+58 SET SDECFDA(409.85,SDIEN_",",13.1)="@"
+59 SET SDECFDA(409.85,SDIEN_",",13.2)="@"
+60 SET SDECFDA(409.85,SDIEN_",",13.3)="@"
+61 SET SDECFDA(409.85,SDIEN_",",13.4)="@"
+62 SET SDECFDA(409.85,SDIEN_",",13.5)="@"
+63 SET SDECFDA(409.85,SDIEN_",",13.6)="@"
+64 SET SDECFDA(409.85,SDIEN_",",13.7)="@"
+65 SET SDECFDA(409.85,SDIEN_",",13.8)="@"
+66 DO UPDATE^DIE("","SDECFDA")
End DoDot:1
+67 QUIT
+68 ;
CANEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CANCEL APPOINTMENT event
+1 ;when appointments cancelled via PIMS interface.
+2 ;Propagates cancellation to SDECAPPT and raises refresh event to running GUI clients
+3 NEW SDECFOUND,SDECRES
+4 if +$GET(SDECNOEV)
QUIT
+5 if '+$GET(SDECSC)
QUIT
+6 SET SDECFOUND=0
+7 IF $DATA(^SDEC(409.831,"ALOC",SDECSC))
SET SDECRES=$ORDER(^SDEC(409.831,"ALOC",SDECSC,0))
SET SDECFOUND=$$CANEVT1(SDECRES,SDECSTART,SDECPAT)
+8 IF SDECFOUND
DO CANEVT3(SDECRES)
QUIT
+9 QUIT
+10 ;
CANEVT1(SDECRES,SDECSTART,SDECPAT) ;
+1 ;Get appointment id in SDECAPT
+2 ;If found, call SDECCAN(SDECAPPT) and return 1
+3 ;else return 0
+4 NEW SDECFOUND,SDECAPPT
+5 SET SDECFOUND=0
+6 if '+SDECRES
QUIT SDECFOUND
+7 if '$DATA(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART))
QUIT SDECFOUND
+8 SET SDECAPPT=0
FOR
SET SDECAPPT=$ORDER(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT))
if '+SDECAPPT
QUIT
Begin DoDot:1
+9 SET SDECNOD=$GET(^SDEC(409.84,SDECAPPT,0))
if SDECNOD=""
QUIT
+10 IF $PIECE(SDECNOD,U,5)=SDECPAT
IF $PIECE(SDECNOD,U,12)=""
SET SDECFOUND=1
QUIT
End DoDot:1
if SDECFOUND
QUIT
+11 IF SDECFOUND
IF +$GET(SDECAPPT)
DO SDECCAN(SDECAPPT,,,,,,1)
+12 QUIT SDECFOUND
+13 ;
CANEVT3(SDECRES) ;
+1 ;Call RaiseEvent to notify GUI clients
+2 ;
+3 QUIT
+4 NEW SDECRESN
+5 SET SDECRESN=$GET(^SDEC(409.831,SDECRES,0))
+6 if SDECRESN=""
QUIT
+7 SET SDECRESN=$PIECE(SDECRESN,"^")
+8 ;D EVENT^SDEC23("SCHEDULE-"_SDECRESN,"","","")
+9 ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN)
+10 QUIT
+11 ;
CANCEL(BSDR) ;EP; called to cancel appt
+1 ;
+2 ; Make call using: S ERR=$$CANCEL^SDEC08(.ARRAY)
+3 ;
+4 ; Input Array -
+5 ; BSDR("PAT") = ien of patient in file 2
+6 ; BSDR("CLN") = ien of clinic in file 44
+7 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
+8 ; BSDR("ADT") = appointment date and time
+9 ; BSDR("CDT") = cancel date and time
+10 ; BSDR("USR") = user who canceled appt
+11 ; BSDR("CR") = cancel reason - pointer to file 409.2
+12 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
+13 ;
+14 ;Output: error status and message
+15 ; = 0 or null: everything okay
+16 ; = 1^message: error and reason
+17 ;
+18 IF '$DATA(^DPT(+$GET(BSDR("PAT")),0))
QUIT 1_U_"Patient not on file: "_$GET(BSDR("PAT"))
+19 IF '$DATA(^SC(+$GET(BSDR("CLN")),0))
QUIT 1_U_"Clinic not on file: "_$GET(BSDR("CLN"))
+20 IF ($GET(BSDR("TYP"))'="C")
IF ($GET(BSDR("TYP"))'="PC")
QUIT 1_U_"Cancel Status error: "_$GET(BSDR("TYP"))
+21 ;remove seconds
IF $GET(BSDR("ADT"))
SET BSDR("ADT")=+$EXTRACT(BSDR("ADT"),1,12)
+22 IF $GET(BSDR("ADT"))'?7N1".".4N
QUIT 1_U_"Appt Date/Time error: "_$GET(BSDR("ADT"))
+23 ;remove seconds
IF $GET(BSDR("CDT"))
SET BSDR("CDT")=+$EXTRACT(BSDR("CDT"),1,12)
+24 IF $GET(BSDR("CDT"))'?7N1".".4N
QUIT 1_U_"Cancel Date/Time error: "_$GET(BSDR("CDT"))
+25 IF '$DATA(^VA(200,+$GET(BSDR("USR")),0))
QUIT 1_U_"User Who Canceled Appt Error: "_$GET(BSDR("USR"))
+26 IF '$DATA(^SD(409.2,+$GET(BSDR("CR"))))
QUIT 1_U_"Cancel Reason error: "_$GET(BSDR("CR"))
+27 ;
+28 NEW IEN,DIE,DA,DR,SDMODE
+29 SET IEN=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+30 IF 'IEN
QUIT 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
+31 ;
+32 IF $$CI^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN)
QUIT 1_U_"Patient already checked in; cannot cancel until check-in deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
+33 ;
+34 ; remember before status
+35 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
+36 SET DFN=BSDR("PAT")
SET SDT=BSDR("ADT")
SET SDCL=BSDR("CLN")
SET SDMODE=2
SET SDDA=IEN
+37 SET SDCPHDL=$$HANDLE^SDAMEVT(1)
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+38 DO BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
+39 ;
+40 ; get user who made appt and date appt made from ^SC
+41 ; because data in ^SC will be deleted
+42 NEW USER,DATE
+43 SET USER=$PIECE($GET(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
+44 SET DATE=$PIECE($GET(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
+45 ;
+46 ; update file 2 info
+47 NEW DIE,DA,DR
+48 NEW SDFDA,SDIEN,SDMSG
+49 SET SDFDA="SDFDA(2.98,SDT_"",""_DFN_"","")"
+50 SET @SDFDA@(3)=BSDR("TYP")
+51 SET @SDFDA@(14)=BSDR("USR")
+52 SET @SDFDA@(15)=BSDR("CDT")
+53 if +$GET(BSDR("CR"))
SET @SDFDA@(16)=BSDR("CR")
+54 if $GET(BSDR("NOT"))]""
SET @SDFDA@(17)=$EXTRACT(BSDR("NOT"),1,160)
+55 SET @SDFDA@(19)=USER
+56 SET @SDFDA@(20)=DATE
+57 DO UPDATE^DIE("","SDFDA")
+58 SET DUZ=$GET(MSGARY("DUZ"))
+59 if $GET(DUZ(2))=""
SET DUZ=$$KSP^XUPARAM("SITE")
+60 NEW SDPCE
+61 SET SDPCE=$PIECE($GET(^DPT(DFN,"S",SDT,0)),U,20)
+62 ;remove OUTPATIENT ENCOUNTER link
if +SDPCE
DO EN^SDCODEL(SDPCE,0)
+63 ;
+64 ; delete data in ^SC
+65 NEW DIK,DA
+66 SET DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
+67 SET DA(2)=BSDR("CLN")
SET DA(1)=BSDR("ADT")
SET DA=IEN
+68 DO ^DIK
+69 ; call event driver
+70 SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+71 ;D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
+72 QUIT 0
+73 ;
UNDOCANA(SDECY,SDECAPTID) ;Undo Cancel Appointment
+1 ;UNDOCANA(SDECY,SDECAPTID) external parameter tag in SDEC
+2 ;called by SDEC UNCANCEL APPT
+3 ; SDECAPTID = ien of appointment in SDEC APPOINTMENT (^SDECAPPT) file 409.84
+4 NEW SDECDAM,SDECDEC,SDECI,SDECNOD,SDECPATID,SDECSTART
+5 ;Don't execute SDEC CANCEL APPOINTMENT protocol ;is this used?
SET SDECNOEV=1
+6 ;
+7 SET SDECI=0
+8 KILL ^TMP("SDEC",$JOB)
+9 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+10 SET ^TMP("SDEC",$JOB,SDECI)="T00020ERRORID"_$CHAR(30)
+11 ;TSTART
+12 ;I '+SDECAPTID TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID.") Q
+13 IF '+SDECAPTID
DO ERR(SDECI+1,"Invalid Appointment ID.")
QUIT
+14 ;I '$D(^SDEC(409.84,SDECAPTID,0)) TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID") Q
+15 IF '$DATA(^SDEC(409.84,SDECAPTID,0))
DO ERR(SDECI+1,"Invalid Appointment ID")
QUIT
+16 ;Make sure appointment is cancelled
+17 ;I $$GET1^DIQ(409.84,SDECAPTID_",",.12)="" TROLLBACK D ERR(SDECI+1,"Appointment is not Cancelled.") Q
+18 IF $$GET1^DIQ(409.84,SDECAPTID_",",.12)=""
DO ERR(SDECI+1,"Appointment is not Cancelled.")
QUIT
+19 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+20 ;appts cancelled by patient cannot be un-cancelled. /* removed 9/17/2010 */
+21 ;I $P(^DPT($P(SDECNOD,U,5),"S",$P(SDECNOD,U,1),0),U,2)="PC" TROLLBACK D ERR(SDECI+1,"Cancelled by patient appointment cannot be uncancelled.") Q
+22 ;get appointment data
+23 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+24 ;date appt made
SET SDECDAM=$PIECE(SDECNOD,U,9)
+25 ;data entry clerk
SET SDECDEC=$PIECE(SDECNOD,U,8)
+26 ;length of appt in minutes
SET SDECLEN=$PIECE(SDECNOD,U,18)
+27 ;note from SDEC APPOINTMENT
SET SDECNOTE=$GET(^SDEC(409.84,SDECAPTID,1,1,0))
+28 ;pointer to VA PATIENT file 2
SET SDECPATID=$PIECE(SDECNOD,U,5)
+29 ;resource
SET SDECSC1=$PIECE($GET(SDECNOD),U,7)
+30 ;appt start time
SET SDECSTART=$PIECE(SDECNOD,U)
+31 ;walk-in
SET SDECWKIN=$PIECE($GET(SDECNOD),U,13)
+32 ;lock SDEC node
+33 ;L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") TROLLBACK Q
+34 LOCK +^SDEC(409.84,SDECPATID):5
IF '$TEST
DO ERR(SDECI+1,"Another user is working with this patient's record. Please try again later")
QUIT
+35 ;un-cancel SDEC APPOINTMENT
+36 DO SDECUCAN(SDECAPTID)
+37 IF SDECSC1]""
IF $DATA(^SDEC(409.831,SDECSC1,0))
Begin DoDot:1
+38 SET SDECLOC=""
+39 SET SDECNOD=^SDEC(409.831,SDECSC1,0)
+40 ;HOSPITAL LOCATION ;support for single HOSPITAL LOCATION in SDEC RESOURCE
SET SDECLOC=$PIECE(SDECNOD,U,4)
+41 ;HOSPITAL LOCATION
IF SDECLOC=""
SET SDECLOC=$$SDCL^SDECUTL(SDECAPTID)
+42 if '+SDECLOC
QUIT
+43 ;un-cancel patient appointment and re-instate clinic appointment
+44 SET SDECZ=""
+45 DO APUCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECSC1,SDECWKIN)
End DoDot:1
IF +$GET(SDECZ)
SET SDECERR=SDECERR_$PIECE(SDECZ,U,2)
DO ERR(SDECI,SDECERR)
QUIT
+46 ;TCOMMIT
+47 LOCK -^SDEC(409.84,SDECPATID)
+48 SET SDECI=SDECI+1
+49 SET ^TMP("SDEC",$JOB,SDECI)=""_$CHAR(30)
+50 SET SDECI=SDECI+1
+51 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+52 QUIT
+53 ;
SDECUCAN(SDECAPTID) ;called internally to update SDEC APPOINTMENT by clearing cancel date/time
+1 NEW PROVIEN,SDAPTYP,SDCL,SDRES
+2 SET SDECIENS=SDECAPTID_","
+3 SET SDECFDA(409.84,SDECIENS,.12)=""
+4 KILL SDECMSG
+5 DO FILE^DIE("","SDECFDA","SDECMSG")
+6 SET SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I")
+7 IF $PIECE(SDAPTYP,";",2)="GMR(123,"
Begin DoDot:1
+8 SET SDCL=$$SDCL^SDECUTL(SDECAPTID)
+9 SET PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I")
+10 DO REQSET^SDEC07A($PIECE(SDAPTYP,";",1),PROVIEN,"",1)
End DoDot:1
+11 QUIT
+12 ;
APUCAN(SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECRES,SDECWKIN) ;
+1 ;un-Cancel appointment for patient SDECDFN in clinic SDECSC1
+2 ; SDECLOC = pointer to hospital location ^SC file 44
+3 ; SDECPATID = pointer to VA Patient ^DPT file 2
+4 ; SDECSTART = Appointment time
+5 ; SDECDAM = Date appointment made in FM format
+6 ; SDECDEC = Data entry clerk - pointer to NEW PERSON file 200
+7 NEW SDECC,%H
+8 SET SDECC("PAT")=SDECPATID
+9 SET SDECC("CLN")=SDECLOC
+10 SET SDECC("ADT")=SDECSTART
+11 ;user note
SET SDECC("NOTE")=SDECNOTE
+12 SET SDECC("RES")=SDECRES
+13 SET SDECC("USR")=DUZ
+14 SET SDECC("LEN")=SDECLEN
+15 SET SDECC("WKIN")=SDECWKIN
+16 ;
+17 SET SDECZ=$$UNCANCEL(.SDECC)
+18 QUIT
+19 ;
UNCANCEL(BSDR) ;PEP; called to un-cancel appt
+1 ;
+2 ; Make call using: S ERR=$$UNCANCEL(.ARRAY)
+3 ;
+4 ; Input Array -
+5 ; BSDR("PAT") = ien of patient in file 2
+6 ; BSDR("CLN") = ien of clinic in file 44
+7 ; BSDR("ADT") = appointment date and time
+8 ; BSDR("USR") = user who un-canceled appt
+9 ; BSDR("NOTE") = appointment note from SDEC APPOINTMENT
+10 ; BSDR("LEN") = appt length in minutes (numeric)
+11 ; BSDR("RES") = resource
+12 ; BSDR("WKIN")= walk-in
+13 ;
+14 ;Output: error status and message
+15 ; = 0 or null: everything okay
+16 ; = 1^message: error and reason
+17 ;
+18 NEW DPTNOD,DPTNODR
+19 IF '$DATA(^DPT(+$GET(BSDR("PAT")),0))
QUIT 1_U_"Patient not on file: "_$GET(BSDR("PAT"))
+20 IF '$DATA(^SC(+$GET(BSDR("CLN")),0))
QUIT 1_U_"Clinic not on file: "_$GET(BSDR("CLN"))
+21 ;remove seconds
IF $GET(BSDR("ADT"))
SET BSDR("ADT")=+$EXTRACT(BSDR("ADT"),1,12)
+22 IF $GET(BSDR("ADT"))'?7N1".".4N
QUIT 1_U_"Appt Date/Time error: "_$GET(BSDR("ADT"))
+23 IF '$DATA(^VA(200,+$GET(BSDR("USR")),0))
QUIT 1_U_"User Who Canceled Appt Error: "_$GET(BSDR("USR"))
+24 ;
+25 ;alb/sat 665 APPVISTA moved to SDEC07B
SET SDECERR=$$APPVISTA^SDEC07B(BSDR("LEN"),BSDR("NOTE"),BSDR("PAT"),BSDR("RES"),BSDR("ADT"),BSDR("WKIN"),BSDR("CLN"),.SDECI)
+26 QUIT SDECERR
+27 ;
ERR(SDECI,SDECERR) ;Error processing
+1 SET SDECI=SDECI+1
+2 SET SDECERR=$TRANSLATE(SDECERR,"^","~")
+3 ;TROLLBACK
+4 SET ^TMP("SDEC",$JOB,SDECI)=SDECERR_$CHAR(30)
+5 SET SDECI=SDECI+1
+6 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+7 QUIT
+8 ;
ETRAP ;EP Error trap entry
+1 DO ^%ZTER
+2 IF '$DATA(SDECI)
NEW SDECI
SET SDECI=999999
+3 SET SDECI=SDECI+1
+4 DO ERR(SDECI,"SDEC08 Error")
+5 QUIT
