SDESCANCELAPPT2 ;ALB/ANU - VISTA SCHEDULING RPCS ;FEB 14, 2022@15:22
;;5.3;Scheduling;**809**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified;
;
;External References
;-------------------
;Reference to UDPATE^DIE in ICR #10018
;Reference to VA(200 in #10060
;Reference to DPT(DFN,"S",+SD,0 in #6053
;
ARCANCEL2(SDECY,SDPATIENTDFN,SDCLNIEN,SDCANCELTYP,SDAPPTDTTM,SDCANCELDTTM,SDUSR,SDCANCELREASON,SDCANCELRMKS) ; Cancel Appointment Request in #2
; Input Parameters
; SDPATIENTDFN = (Req) ien of patient file 2
; SDCLNIEN = (Req) ien of clinic file 44
; SDCANCELTYP = (Req) C for canceled by clinic; PC for patient canceled
; SDAPPTDTTM = (Req) appointment date and time in ISO 8601 extended format (e.g. 2022-01-19T20:15:44)
; SDCANCELDTTM = cancel date and time in ISO 8601 extended format
; SDUSR = user who canceled appt
; SDCANCELREASON = (Req) cancel reason - pointer to file 409.2
; SDCANCELRMKS = cancel remarks - optional notes to 160 characters
;
N POP,SDAPTREQ
D VALIDATE
I 'POP D UPDATE
D BUILDER
Q
;
VALIDATE ;
S POP=0
;
; Patient DFN
S SDPATIENTDFN=$G(SDPATIENTDFN,"")
I SDPATIENTDFN="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,1) Q
I SDPATIENTDFN'="",'$D(^DPT(+SDPATIENTDFN,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,2) Q
;
; Clinic IEN
S SDCLNIEN=$G(SDCLNIEN,"")
I SDCLNIEN="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,18) Q
I '$D(^SC(+SDCLNIEN,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,19) Q
;
; Appointment Status
I $G(SDCANCELTYP)="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,38) Q
I ($G(SDCANCELTYP)'="C"),($G(SDCANCELTYP)'="PC") S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,30) Q
;
; Date/time of appt
S SDAPPTDTTM=$G(SDAPPTDTTM,"")
I SDAPPTDTTM="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,76) Q
S SDAPPTDTTM=$$ISOTFM^SDAMUTDT(SDAPPTDTTM,SDCLNIEN)
I SDAPPTDTTM=-1 S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,77) Q
;
; Cancel Date/time of appt
S SDCANCELDTTM=$G(SDCANCELDTTM,"")
I SDCANCELDTTM'="" D
. S SDCANCELDTTM=$$ISOTFM^SDAMUTDT(SDCANCELDTTM,SDCLNIEN)
. I SDCANCELDTTM=-1 S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,144) Q
I SDCANCELDTTM="" S SDCANCELDTTM=DT
I POP=1 Q
;
; User
I SDUSR'="" I '$D(^VA(200,+SDUSR,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,44) Q
I $G(SDUSR)="" S SDUSR=$G(DUZ)
;
; Cancellation Reason
I $G(SDCANCELREASON)="" D ERRLOG^SDESJSON(.SDAPTREQ,128) S POP=1 Q
I ($G(SDCANCELREASON)'=""),('$D(^SD(409.2,"B",SDCANCELREASON))) D ERRLOG^SDESJSON(.SDAPTREQ,129) S POP=1 Q
S SDCANCELREASON=$O(^SD(409.2,"B",SDCANCELREASON,0))
;
I SDAPPTDTTM'="",'$D(^DPT(+SDPATIENTDFN,"S",SDAPPTDTTM,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,52,"No Appt Found in File #2 for this Date/Time") Q
I SDAPPTDTTM'="",(($P(^DPT(SDPATIENTDFN,"S",SDAPPTDTTM,0),U,2)="C")!($P(^DPT(SDPATIENTDFN,"S",SDAPPTDTTM,0),U,2)="PC")) S POP=1 S SDAPTREQ("Error",1)="This Appointment is already cancelled." Q
Q
;
UPDATE ;
; update file 2 info
NEW DIE,DA,DR
N SDFDA,SDMSG
S SDFDA="SDFDA(2.98,SDAPPTDTTM_"",""_SDPATIENTDFN_"","")"
S @SDFDA@(3)=SDCANCELTYP
S @SDFDA@(14)=SDUSR
S @SDFDA@(15)=SDCANCELDTTM
S:$G(SDCANCELREASON) @SDFDA@(16)=SDCANCELREASON
S:$G(SDCANCELRMKS)]"" @SDFDA@(17)=$E(SDCANCELRMKS,1,160)
S @SDFDA@(19)=SDUSR
K SDERR D UPDATE^DIE("","SDFDA","","SDERR")
I $D(SDERR) S SDAPTREQ("Error",1)="Error trying to cancel Appointment in File #2." Q
S SDAPTREQ("Success")="Appointment is successfully cancelled."
Q
;
BUILDER ;Convert data to JSON
N JSONERR
S JSONERR=""
D ENCODE^SDESJSON(.SDAPTREQ,.SDECY,.JSONERR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCANCELAPPT2 3580 printed Dec 13, 2024@02:55:55 Page 2
SDESCANCELAPPT2 ;ALB/ANU - VISTA SCHEDULING RPCS ;FEB 14, 2022@15:22
+1 ;;5.3;Scheduling;**809**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified;
+3 ;
+4 ;External References
+5 ;-------------------
+6 ;Reference to UDPATE^DIE in ICR #10018
+7 ;Reference to VA(200 in #10060
+8 ;Reference to DPT(DFN,"S",+SD,0 in #6053
+9 ;
ARCANCEL2(SDECY,SDPATIENTDFN,SDCLNIEN,SDCANCELTYP,SDAPPTDTTM,SDCANCELDTTM,SDUSR,SDCANCELREASON,SDCANCELRMKS) ; Cancel Appointment Request in #2
+1 ; Input Parameters
+2 ; SDPATIENTDFN = (Req) ien of patient file 2
+3 ; SDCLNIEN = (Req) ien of clinic file 44
+4 ; SDCANCELTYP = (Req) C for canceled by clinic; PC for patient canceled
+5 ; SDAPPTDTTM = (Req) appointment date and time in ISO 8601 extended format (e.g. 2022-01-19T20:15:44)
+6 ; SDCANCELDTTM = cancel date and time in ISO 8601 extended format
+7 ; SDUSR = user who canceled appt
+8 ; SDCANCELREASON = (Req) cancel reason - pointer to file 409.2
+9 ; SDCANCELRMKS = cancel remarks - optional notes to 160 characters
+10 ;
+11 NEW POP,SDAPTREQ
+12 DO VALIDATE
+13 IF 'POP
DO UPDATE
+14 DO BUILDER
+15 QUIT
+16 ;
VALIDATE ;
+1 SET POP=0
+2 ;
+3 ; Patient DFN
+4 SET SDPATIENTDFN=$GET(SDPATIENTDFN,"")
+5 IF SDPATIENTDFN=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,1)
QUIT
+6 IF SDPATIENTDFN'=""
IF '$DATA(^DPT(+SDPATIENTDFN,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,2)
QUIT
+7 ;
+8 ; Clinic IEN
+9 SET SDCLNIEN=$GET(SDCLNIEN,"")
+10 IF SDCLNIEN=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,18)
QUIT
+11 IF '$DATA(^SC(+SDCLNIEN,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,19)
QUIT
+12 ;
+13 ; Appointment Status
+14 IF $GET(SDCANCELTYP)=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,38)
QUIT
+15 IF ($GET(SDCANCELTYP)'="C")
IF ($GET(SDCANCELTYP)'="PC")
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,30)
QUIT
+16 ;
+17 ; Date/time of appt
+18 SET SDAPPTDTTM=$GET(SDAPPTDTTM,"")
+19 IF SDAPPTDTTM=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,76)
QUIT
+20 SET SDAPPTDTTM=$$ISOTFM^SDAMUTDT(SDAPPTDTTM,SDCLNIEN)
+21 IF SDAPPTDTTM=-1
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,77)
QUIT
+22 ;
+23 ; Cancel Date/time of appt
+24 SET SDCANCELDTTM=$GET(SDCANCELDTTM,"")
+25 IF SDCANCELDTTM'=""
Begin DoDot:1
+26 SET SDCANCELDTTM=$$ISOTFM^SDAMUTDT(SDCANCELDTTM,SDCLNIEN)
+27 IF SDCANCELDTTM=-1
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,144)
QUIT
End DoDot:1
+28 IF SDCANCELDTTM=""
SET SDCANCELDTTM=DT
+29 IF POP=1
QUIT
+30 ;
+31 ; User
+32 IF SDUSR'=""
IF '$DATA(^VA(200,+SDUSR,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,44)
QUIT
+33 IF $GET(SDUSR)=""
SET SDUSR=$GET(DUZ)
+34 ;
+35 ; Cancellation Reason
+36 IF $GET(SDCANCELREASON)=""
DO ERRLOG^SDESJSON(.SDAPTREQ,128)
SET POP=1
QUIT
+37 IF ($GET(SDCANCELREASON)'="")
IF ('$DATA(^SD(409.2,"B",SDCANCELREASON)))
DO ERRLOG^SDESJSON(.SDAPTREQ,129)
SET POP=1
QUIT
+38 SET SDCANCELREASON=$ORDER(^SD(409.2,"B",SDCANCELREASON,0))
+39 ;
+40 IF SDAPPTDTTM'=""
IF '$DATA(^DPT(+SDPATIENTDFN,"S",SDAPPTDTTM,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,52,"No Appt Found in File #2 for this Date/Time")
QUIT
+41 IF SDAPPTDTTM'=""
IF (($PIECE(^DPT(SDPATIENTDFN,"S",SDAPPTDTTM,0),U,2)="C")!($PIECE(^DPT(SDPATIENTDFN,"S",SDAPPTDTTM,0),U,2)="PC"))
SET POP=1
SET SDAPTREQ("Error",1)="This Appointment is already cancelled."
QUIT
+42 QUIT
+43 ;
UPDATE ;
+1 ; update file 2 info
+2 NEW DIE,DA,DR
+3 NEW SDFDA,SDMSG
+4 SET SDFDA="SDFDA(2.98,SDAPPTDTTM_"",""_SDPATIENTDFN_"","")"
+5 SET @SDFDA@(3)=SDCANCELTYP
+6 SET @SDFDA@(14)=SDUSR
+7 SET @SDFDA@(15)=SDCANCELDTTM
+8 if $GET(SDCANCELREASON)
SET @SDFDA@(16)=SDCANCELREASON
+9 if $GET(SDCANCELRMKS)]""
SET @SDFDA@(17)=$EXTRACT(SDCANCELRMKS,1,160)
+10 SET @SDFDA@(19)=SDUSR
+11 KILL SDERR
DO UPDATE^DIE("","SDFDA","","SDERR")
+12 IF $DATA(SDERR)
SET SDAPTREQ("Error",1)="Error trying to cancel Appointment in File #2."
QUIT
+13 SET SDAPTREQ("Success")="Appointment is successfully cancelled."
+14 QUIT
+15 ;
BUILDER ;Convert data to JSON
+1 NEW JSONERR
+2 SET JSONERR=""
+3 DO ENCODE^SDESJSON(.SDAPTREQ,.SDECY,.JSONERR)
+4 QUIT
