Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDESCANCELAPPT2

SDESCANCELAPPT2.m

Go to the documentation of this file.
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