SDESCANCELAPPTS ;ALB/BLB,LAB,MGD,BWF,MCB - SCHEDULING CANCEL APPOINTMENTS RPC ;Mar 3, 2023
;;5.3;Scheduling;**818,820,828,835,837,842,844,871**;Aug 13, 1993;Build 13
;;Per VHA Directive 6402, this routine should not be modified
;
;Cancel appointments in files 409.84, 44, 2.
;
;APPTIEN - (required) pointer to SDEC APPOINTMENT file #409.84
;CLINICIEN -(required) pointer to hospital location file #44
;DFN -(required) pointer to patient file #2
;CANBYCLINORPAT - (required) appointment Status valid values: C=CANCELLED BY CLINIC ; PC=CANCELLED BY PATIENT
;CANCELREASONIEN - (required) pointer to CANCELLATION REASON File (409.2)
;NOTE - (optional) text representing user note
;CANCELHASH - (optional) List of cancellation comment hash tags (see #409.88) separated by ^
;EAS - (optional) Enterprise Appointment Scheduling Tracking Number associated to an appointment.
;
Q
;
CANCELAPPTS(JSONRETURN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,CANCELREASONIEN,NOTE,CANCELHASH,EAS) ;
N ERRORS,ISAPPTIENVALID,ORDERLOCK,ISCANBYVALID,ISCANREASONVALID,ISDFNVALID,SDATA,ISCLINICVALID,APPTENDTIME,APPTSTARTTIME,PROVIEN
N ISEASVALID,ISCANBYVALID,ISNOTEVALID,ISCANDTTMVALID,EDITED,CLINICSUBIEN,IS2CANCELLED,IS40984CANCELLED,IS44CANCELLED,REQUESTTYPE,REQUESTIEN
N RECALLREQIEN,RECALLREQLINK,RESOURCE,OLDRECALLPTR,RETURN,RECALLRET,APPTLENGTH,IENS44
;
S ORDERLOCK=$$ORDERCHECKLOCK(.ERRORS,$G(APPTIEN),$G(DFN))
I ORDERLOCK M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
S ISAPPTIENVALID=$$VALIDATEAPPTIEN(.ERRORS,$G(APPTIEN))
;
S ISCLINICVALID=$$VALIDATECLINIC(.ERRORS,$G(CLINICIEN),$G(APPTIEN))
;
S ISDFNVALID=$$VALIDATEDFN(.ERRORS,$G(DFN),$G(APPTIEN))
;
S ISCANBYVALID=$$VALIDATECANBY(.ERRORS,$G(CANBYCLINORPAT))
;
S ISCANREASONVALID=$$VALIDATECANREAS(.ERRORS,$G(CANCELREASONIEN))
;
S NOTE=$$VALIDATENOTE(.ERRORS,$G(NOTE),$G(CANCELHASH))
;
S ISEASVALID=$$VALIDATEEAS(.ERRORS,$G(EAS))
;
I $D(ERRORS) S ERRORS("Appointment",1)="" M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
;
; cancel appointments
;
S APPTSTARTTIME=$$GET1^DIQ(409.84,$G(APPTIEN),.01,"I")
S REQUESTTYPE=$P($$GET1^DIQ(409.84,$G(APPTIEN),.22,"I"),";",2),REQUESTTYPE=$S(REQUESTTYPE="GMR(123,":"CONSULT",REQUESTTYPE="SD(403.5,":"RECALL",REQUESTTYPE="SDEC(409.85,":"APPTREQ",1:"")
S REQUESTIEN=$P($$GET1^DIQ(409.84,$G(APPTIEN),.22,"I"),";")
S APPTENDTIME=$$GET1^DIQ(409.84,$G(APPTIEN),.02,"I")
S RESOURCE=$$GET1^DIQ(409.84,$G(APPTIEN),.07,"I")
S IENS44=$$GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN)
;
S CLINICSUBIEN=$$BEFOREEVENT($G(DFN),$G(APPTSTARTTIME),$G(CLINICIEN),.SDATA)
;
S IS40984CANCELLED=$$CANCEL40984(.ERRORS,$G(APPTIEN),$G(CANCELREASONIEN),$G(CANBYCLINORPAT),$G(EAS))
;
S IS44CANCELLED=$$CANCEL44(.ERRORS,$G(CLINICIEN),$G(APPTSTARTTIME),$G(DFN),$G(APPTIEN),$G(IENS44))
;
S IS2CANCELLED=$$CANCEL2(.ERRORS,$G(DFN),$G(APPTSTARTTIME),$G(CANBYCLINORPAT),$G(CANCELREASONIEN),$G(NOTE),$G(APPTIEN),$G(CLINICIEN),$G(IENS44))
;
I $D(ERRORS) S ERRORS("Appointment",1)="" M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
I REQUESTTYPE="APPTREQ" D
.D OPENAPPTREQUEST^SDESCANAPPT2(REQUESTIEN,$G(APPTIEN))
.D DELETEAPPTDATA(REQUESTIEN)
.D REMOVEMRTCAPTIEN^SDESCANAPPT2(REQUESTIEN,APPTIEN)
.; update contact main sequence upon re-open
.D UPDCONTSEQ^SDESCONTACTS($G(DFN),$G(REQUESTIEN))
;
I REQUESTTYPE="RECALL" D
.D REOPEN^SDESRECALLREQ(.RECALLRET,$G(APPTIEN),,,CANBYCLINORPAT)
.S RECALLREQIEN=$P(RECALLRET,U)
.S RECALLREQLINK=$P(RECALLRET,U,2)
.S OLDRECALLPTR=$P(RECALLRET,U,3)
.; update contact main sequence upon re-open
.D UPDCONTSEQ^SDESCONTACTS($G(DFN),$G(RECALLREQIEN),$G(RECALLREQLINK),$G(OLDRECALLPTR))
;
I REQUESTTYPE="CONSULT" D
.S PROVIEN=$$GET1^DIQ(44,CLINICIEN,16,"I")
.D REQSET^SDESCONSULTUPD(REQUESTIEN,PROVIEN,"",2,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE)
.; update contact main sequence upon re-open
.D UPDCONTSEQ^SDESCONTACTS($G(DFN),$G(REQUESTIEN))
;
S APPTLENGTH=$$GET1^DIQ(409.84,APPTIEN,.18,"I")
D AVUPDT^SDEC08A(CLINICIEN,APPTSTARTTIME,APPTLENGTH)
D AFTEREVENT($G(DFN),$G(APPTSTARTTIME),$G(CLINICIEN),$G(CLINICSUBIEN),.SDATA)
;
; Update AMIE C&P EXAM TRACKING (#396.95) record if this appointment is a Compensation and Pension appointment
I $$GET1^DIQ(409.84,APPTIEN,.06,"E")="COMPENSATION & PENSION" D AMIECAN^SDESCOMPPEN(.RETURN,DFN,APPTSTARTTIME)
;
S RETURN("Appointment","Cancelled")=$G(APPTIEN)
D BUILDJSON(.JSONRETURN,.RETURN) Q
Q
;
OPENAPPTREQUEST(REQUESTIEN,APPTIEN) ;
N CANCELREASON,REQUESTFDA,REQUESTERR
S REQUESTIEN=REQUESTIEN_","
S REQUESTFDA(409.85,REQUESTIEN,19)=""
S REQUESTFDA(409.85,REQUESTIEN,20)=""
S REQUESTFDA(409.85,REQUESTIEN,21)=""
S CANCELREASON=$$GET1^DIQ(409.84,APPTIEN,.122,"I")
; does cancel reason allow request to re-open
I $$GET1^DIQ(409.2,CANCELREASON,5,"I")'=0 D
.S REQUESTFDA(409.85,REQUESTIEN,23)="OPEN"
D FILE^DIE("","REQUESTFDA","REQUESTERR") K REQUESTFDA
Q
;
DELETEAPPTDATA(REQUESTIEN) ;
N APPTFDA,APPTERR
S REQUESTIEN=$G(REQUESTIEN)_","
S APPTFDA(409.85,REQUESTIEN,13)="@"
S APPTFDA(409.85,REQUESTIEN,13.1)="@"
S APPTFDA(409.85,REQUESTIEN,13.2)="@"
S APPTFDA(409.85,REQUESTIEN,13.3)="@"
S APPTFDA(409.85,REQUESTIEN,13.4)="@"
S APPTFDA(409.85,REQUESTIEN,13.6)="@"
S APPTFDA(409.85,REQUESTIEN,13.7)="@"
S APPTFDA(409.85,REQUESTIEN,13.8)="@"
S APPTFDA(409.85,REQUESTIEN,100)=$G(EAS)
D FILE^DIE(,"APPTFDA","APPTERR") K APPTFDA
Q
;
ORDERCHECKLOCK(ERRORS,APPTIEN,DFN) ;
N FOUND,REQUESTIEN,ORDERID,APPTREQTYPE,REQTYPE
S APPTREQTYPE=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
S REQUESTIEN=$P($G(APPTREQTYPE),";")
S REQTYPE=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
S FOUND=0
I REQTYPE="RTC" D
.S ORDERID=$$GET1^DIQ(409.85,REQUESTIEN,46,"I")
.I '+$G(ORDERID) Q
.I $D(^XTMP("ORPTLK-"_DFN)) D ERRLOG^SDESJSON(.ERRORS,188) S FOUND=1
Q FOUND
;
VALIDATEAPPTIEN(ERRORS,APPTIEN) ;
I APPTIEN="" D ERRLOG^SDESJSON(.ERRORS,14) Q 0
I APPTIEN'="",'$D(^SDEC(409.84,APPTIEN,0)) D ERRLOG^SDESJSON(.ERRORS,15) Q 0
Q 1
;
VALIDATECANBY(ERRORS,CANBYCLINORPAT) ;
I CANBYCLINORPAT="" D ERRLOG^SDESJSON(.ERRORS,190) Q 0
I CANBYCLINORPAT'="C",CANBYCLINORPAT'="PC" D ERRLOG^SDESJSON(.ERRORS,189) Q 0
Q 1
;
VALIDATECLINIC(ERRORS,CLINICIEN,APPTIEN) ;
N RESOURCEIEN,LINKEDCLINIC
I CLINICIEN="" D ERRLOG^SDESJSON(.ERRORS,18) Q 0
I CLINICIEN'="",'$D(^SC(CLINICIEN,0)) D ERRLOG^SDESJSON(.ERRORS,19) Q 0
S RESOURCEIEN=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
S LINKEDCLINIC=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
I CLINICIEN'=LINKEDCLINIC D ERRLOG^SDESJSON(.ERRORS,193) Q 0
Q 1
;
VALIDATEDFN(ERRORS,DFN,APPTIEN) ;
I DFN="" D ERRLOG^SDESJSON(.ERRORS,1) Q 0
I DFN'="",'$D(^DPT(DFN,0)) D ERRLOG^SDESJSON(.ERRORS,2) Q 0
I $$GET1^DIQ(409.84,APPTIEN,.05,"I")'=DFN D ERRLOG^SDESJSON(.ERRORS,194) Q 0
Q 1
;
VALIDATECANREAS(ERRORS,CANCELREASONIEN) ;
I CANCELREASONIEN="" D ERRLOG^SDESJSON(.ERRORS,128) Q 0
I '$D(^SD(409.2,CANCELREASONIEN,0)) D ERRLOG^SDESJSON(.ERRORS,129) Q 0
Q 1
;
VALIDATENOTE(ERRORS,NOTE,CANCELHASH) ;
N SDECJ
S NOTE=$TR($G(NOTE),"^"," ") ;
; Add cancellation comment HASHTAGs from #409.88 to beginning of user note. - 756 wtc 6/8/2020
I $G(CANCELHASH)'="" F SDECJ=$L(CANCELHASH,U):-1:1 S NOTE=$P(CANCELHASH,U,SDECJ)_"_"_NOTE
I $E(NOTE,$L(NOTE))="_" S NOTE=$E(NOTE,1,$L(NOTE)-1)
Q NOTE
;
VALIDATEEAS(ERRORS,EAS) ;
I $L(EAS) S EAS=$$EASVALIDATE^SDESUTIL($G(EAS))
I $P($G(EAS),U)=-1 D ERRLOG^SDESJSON(.ERRORS,142) Q 0
Q 1
;
CANCEL40984(ERRORS,APPTIEN,CANCELREASONIEN,CANBYCLINORPAT,EAS) ;
N IENS,FDA40984,ERR84
S IENS=APPTIEN_","
S FDA40984(409.84,IENS,.12)=$$NOW^XLFDT
S FDA40984(409.84,IENS,.121)=DUZ
S FDA40984(409.84,IENS,.122)=CANCELREASONIEN
S FDA40984(409.84,IENS,.17)=CANBYCLINORPAT
S FDA40984(409.84,IENS,100)=EAS
L +^SDEC(APPTIEN):3 I '$T D ERRLOG^SDESJSON(.ERRORS,192) Q 0
D FILE^DIE("","FDA40984","ERR84") K FDA40984
L -^SDEC(APPTIEN)
I $D(ERR84) D ERRLOG^SDESJSON(.ERRORS,191) Q 0
Q 1
;
CANCEL44(ERRORS,CLINICIEN,APPTSTARTTIME,DFN,APPTIEN,IENS44) ; FIELD 310 OF 44.003 SET TO "C"
N FDA44003,ERR44003,SUBIEN
;
S FDA44003(44.003,IENS44,310)="C"
L +^SC(CLINICIEN):3 I '$T D ERRLOG^SDESJSON(.ERRORS,186),CLEAN40984(APPTIEN) Q 0
D FILE^DIE("","FDA44003","ERR44003") K FDA44003
L -^SC(CLINICIEN)
I $D(ERR44003) D ERRLOG^SDESJSON(.ERRORS,191) D CLEAN40984(APPTIEN) Q 0
Q 1
;
CANCEL2(ERRORS,DFN,APPTSTARTTIME,CANBYCLINORPAT,CANCELREASIONIEN,NOTE,APPTIEN,CLINICIEN,IENS44) ;
N IENS,FDA298,ERR298
S IENS=APPTSTARTTIME_","_DFN_","
S FDA298(2.98,IENS,3)=CANBYCLINORPAT
S FDA298(2.98,IENS,14)=DUZ
S FDA298(2.98,IENS,15)=$$NOW^XLFDT
S FDA298(2.98,IENS,16)=CANCELREASONIEN
S FDA298(2.98,IENS,17)=NOTE
L +^DPT(DFN):3 I '$T D ERRLOG^SDESJSON(.ERRORS,187),CLEAN40984(APPTIEN),CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44) Q 0
D FILE^DIE("","FDA298","ERR298") K FDA298
L -^DPT(DFN)
I $D(ERR298) D ERRLOG^SDESJSON(.ERRORS,191),CLEAN40984(APPTIEN),CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44) Q 0
Q 1
;
GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN) ;
N FOUND,IENS44003
S FOUND=0
S SUBIEN=0 F S SUBIEN=$O(^SC(CLINICIEN,"S",APPTSTARTTIME,1,SUBIEN)) Q:'SUBIEN!($G(FOUND)=1) D
.I $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",310,"E")="CANCELLED" Q
.I $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",.01,"I")=DFN D
..S IENS44003=SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",FOUND=1 Q
Q $G(IENS44003)
;
CLEAN40984(APPTIEN) ;
N FDA40984,IENS,ERR84
S IENS=APPTIEN_","
S FDA40984(409.84,IENS,.12)=""
S FDA40984(409.84,IENS,.121)=""
S FDA40984(409.84,IENS,.122)=""
S FDA40984(409.84,IENS,.17)=""
S FDA40984(409.84,IENS,100)=""
D FILE^DIE("","FDA40984","ERR84") K FDA40984
Q
;
CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44) ;
N FDA44003,ERR44003
;
S FDA44003(44.003,IENS44,310)=""
D FILE^DIE("","FDA44003","ERR44003") K FDA44003
Q
;
BEFOREEVENT(DFN,APPTSTARTTIME,CLINICIEN,SDATA) ;
N SDDA,SDCPHDL
S SDDA=$$SCIEN^SDECU2(DFN,CLINICIEN,APPTSTARTTIME)
S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
D BEFORE^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDCPHDL)
Q $G(SDDA)
AFTEREVENT(DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDATA) ;
N SDCPHDL
S SDCPHDL=$$HANDLE^SDAMEVT(1)
S SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
D CANCEL^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,2,SDCPHDL) ;*zeb 10/25/18 722 uncomment to re-enable event driver
Q
BUILDJSON(JSONRETURN,RETURN) ;.
N JSONERROR
D ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCANCELAPPTS 10652 printed Apr 09, 2024@21:55:51 Page 2
SDESCANCELAPPTS ;ALB/BLB,LAB,MGD,BWF,MCB - SCHEDULING CANCEL APPOINTMENTS RPC ;Mar 3, 2023
+1 ;;5.3;Scheduling;**818,820,828,835,837,842,844,871**;Aug 13, 1993;Build 13
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;Cancel appointments in files 409.84, 44, 2.
+5 ;
+6 ;APPTIEN - (required) pointer to SDEC APPOINTMENT file #409.84
+7 ;CLINICIEN -(required) pointer to hospital location file #44
+8 ;DFN -(required) pointer to patient file #2
+9 ;CANBYCLINORPAT - (required) appointment Status valid values: C=CANCELLED BY CLINIC ; PC=CANCELLED BY PATIENT
+10 ;CANCELREASONIEN - (required) pointer to CANCELLATION REASON File (409.2)
+11 ;NOTE - (optional) text representing user note
+12 ;CANCELHASH - (optional) List of cancellation comment hash tags (see #409.88) separated by ^
+13 ;EAS - (optional) Enterprise Appointment Scheduling Tracking Number associated to an appointment.
+14 ;
+15 QUIT
+16 ;
CANCELAPPTS(JSONRETURN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,CANCELREASONIEN,NOTE,CANCELHASH,EAS) ;
+1 NEW ERRORS,ISAPPTIENVALID,ORDERLOCK,ISCANBYVALID,ISCANREASONVALID,ISDFNVALID,SDATA,ISCLINICVALID,APPTENDTIME,APPTSTARTTIME,PROVIEN
+2 NEW ISEASVALID,ISCANBYVALID,ISNOTEVALID,ISCANDTTMVALID,EDITED,CLINICSUBIEN,IS2CANCELLED,IS40984CANCELLED,IS44CANCELLED,REQUESTTYPE,REQUESTIEN
+3 NEW RECALLREQIEN,RECALLREQLINK,RESOURCE,OLDRECALLPTR,RETURN,RECALLRET,APPTLENGTH,IENS44
+4 ;
+5 SET ORDERLOCK=$$ORDERCHECKLOCK(.ERRORS,$GET(APPTIEN),$GET(DFN))
+6 IF ORDERLOCK
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+7 ;
+8 SET ISAPPTIENVALID=$$VALIDATEAPPTIEN(.ERRORS,$GET(APPTIEN))
+9 ;
+10 SET ISCLINICVALID=$$VALIDATECLINIC(.ERRORS,$GET(CLINICIEN),$GET(APPTIEN))
+11 ;
+12 SET ISDFNVALID=$$VALIDATEDFN(.ERRORS,$GET(DFN),$GET(APPTIEN))
+13 ;
+14 SET ISCANBYVALID=$$VALIDATECANBY(.ERRORS,$GET(CANBYCLINORPAT))
+15 ;
+16 SET ISCANREASONVALID=$$VALIDATECANREAS(.ERRORS,$GET(CANCELREASONIEN))
+17 ;
+18 SET NOTE=$$VALIDATENOTE(.ERRORS,$GET(NOTE),$GET(CANCELHASH))
+19 ;
+20 SET ISEASVALID=$$VALIDATEEAS(.ERRORS,$GET(EAS))
+21 ;
+22 IF $DATA(ERRORS)
SET ERRORS("Appointment",1)=""
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+23 ;
+24 ;
+25 ; cancel appointments
+26 ;
+27 SET APPTSTARTTIME=$$GET1^DIQ(409.84,$GET(APPTIEN),.01,"I")
+28 SET REQUESTTYPE=$PIECE($$GET1^DIQ(409.84,$GET(APPTIEN),.22,"I"),";",2)
SET REQUESTTYPE=$SELECT(REQUESTTYPE="GMR(123,":"CONSULT",REQUESTTYPE="SD(403.5,":"RECALL",REQUESTTYPE="SDEC(409.85,":"APPTREQ",1:"")
+29 SET REQUESTIEN=$PIECE($$GET1^DIQ(409.84,$GET(APPTIEN),.22,"I"),";")
+30 SET APPTENDTIME=$$GET1^DIQ(409.84,$GET(APPTIEN),.02,"I")
+31 SET RESOURCE=$$GET1^DIQ(409.84,$GET(APPTIEN),.07,"I")
+32 SET IENS44=$$GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN)
+33 ;
+34 SET CLINICSUBIEN=$$BEFOREEVENT($GET(DFN),$GET(APPTSTARTTIME),$GET(CLINICIEN),.SDATA)
+35 ;
+36 SET IS40984CANCELLED=$$CANCEL40984(.ERRORS,$GET(APPTIEN),$GET(CANCELREASONIEN),$GET(CANBYCLINORPAT),$GET(EAS))
+37 ;
+38 SET IS44CANCELLED=$$CANCEL44(.ERRORS,$GET(CLINICIEN),$GET(APPTSTARTTIME),$GET(DFN),$GET(APPTIEN),$GET(IENS44))
+39 ;
+40 SET IS2CANCELLED=$$CANCEL2(.ERRORS,$GET(DFN),$GET(APPTSTARTTIME),$GET(CANBYCLINORPAT),$GET(CANCELREASONIEN),$GET(NOTE),$GET(APPTIEN),$GET(CLINICIEN),$GET(IENS44))
+41 ;
+42 IF $DATA(ERRORS)
SET ERRORS("Appointment",1)=""
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+43 ;
+44 IF REQUESTTYPE="APPTREQ"
Begin DoDot:1
+45 DO OPENAPPTREQUEST^SDESCANAPPT2(REQUESTIEN,$GET(APPTIEN))
+46 DO DELETEAPPTDATA(REQUESTIEN)
+47 DO REMOVEMRTCAPTIEN^SDESCANAPPT2(REQUESTIEN,APPTIEN)
+48 ; update contact main sequence upon re-open
+49 DO UPDCONTSEQ^SDESCONTACTS($GET(DFN),$GET(REQUESTIEN))
End DoDot:1
+50 ;
+51 IF REQUESTTYPE="RECALL"
Begin DoDot:1
+52 DO REOPEN^SDESRECALLREQ(.RECALLRET,$GET(APPTIEN),,,CANBYCLINORPAT)
+53 SET RECALLREQIEN=$PIECE(RECALLRET,U)
+54 SET RECALLREQLINK=$PIECE(RECALLRET,U,2)
+55 SET OLDRECALLPTR=$PIECE(RECALLRET,U,3)
+56 ; update contact main sequence upon re-open
+57 DO UPDCONTSEQ^SDESCONTACTS($GET(DFN),$GET(RECALLREQIEN),$GET(RECALLREQLINK),$GET(OLDRECALLPTR))
End DoDot:1
+58 ;
+59 IF REQUESTTYPE="CONSULT"
Begin DoDot:1
+60 SET PROVIEN=$$GET1^DIQ(44,CLINICIEN,16,"I")
+61 DO REQSET^SDESCONSULTUPD(REQUESTIEN,PROVIEN,"",2,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE)
+62 ; update contact main sequence upon re-open
+63 DO UPDCONTSEQ^SDESCONTACTS($GET(DFN),$GET(REQUESTIEN))
End DoDot:1
+64 ;
+65 SET APPTLENGTH=$$GET1^DIQ(409.84,APPTIEN,.18,"I")
+66 DO AVUPDT^SDEC08A(CLINICIEN,APPTSTARTTIME,APPTLENGTH)
+67 DO AFTEREVENT($GET(DFN),$GET(APPTSTARTTIME),$GET(CLINICIEN),$GET(CLINICSUBIEN),.SDATA)
+68 ;
+69 ; Update AMIE C&P EXAM TRACKING (#396.95) record if this appointment is a Compensation and Pension appointment
+70 IF $$GET1^DIQ(409.84,APPTIEN,.06,"E")="COMPENSATION & PENSION"
DO AMIECAN^SDESCOMPPEN(.RETURN,DFN,APPTSTARTTIME)
+71 ;
+72 SET RETURN("Appointment","Cancelled")=$GET(APPTIEN)
+73 DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+74 QUIT
+75 ;
OPENAPPTREQUEST(REQUESTIEN,APPTIEN) ;
+1 NEW CANCELREASON,REQUESTFDA,REQUESTERR
+2 SET REQUESTIEN=REQUESTIEN_","
+3 SET REQUESTFDA(409.85,REQUESTIEN,19)=""
+4 SET REQUESTFDA(409.85,REQUESTIEN,20)=""
+5 SET REQUESTFDA(409.85,REQUESTIEN,21)=""
+6 SET CANCELREASON=$$GET1^DIQ(409.84,APPTIEN,.122,"I")
+7 ; does cancel reason allow request to re-open
+8 IF $$GET1^DIQ(409.2,CANCELREASON,5,"I")'=0
Begin DoDot:1
+9 SET REQUESTFDA(409.85,REQUESTIEN,23)="OPEN"
End DoDot:1
+10 DO FILE^DIE("","REQUESTFDA","REQUESTERR")
KILL REQUESTFDA
+11 QUIT
+12 ;
DELETEAPPTDATA(REQUESTIEN) ;
+1 NEW APPTFDA,APPTERR
+2 SET REQUESTIEN=$GET(REQUESTIEN)_","
+3 SET APPTFDA(409.85,REQUESTIEN,13)="@"
+4 SET APPTFDA(409.85,REQUESTIEN,13.1)="@"
+5 SET APPTFDA(409.85,REQUESTIEN,13.2)="@"
+6 SET APPTFDA(409.85,REQUESTIEN,13.3)="@"
+7 SET APPTFDA(409.85,REQUESTIEN,13.4)="@"
+8 SET APPTFDA(409.85,REQUESTIEN,13.6)="@"
+9 SET APPTFDA(409.85,REQUESTIEN,13.7)="@"
+10 SET APPTFDA(409.85,REQUESTIEN,13.8)="@"
+11 SET APPTFDA(409.85,REQUESTIEN,100)=$GET(EAS)
+12 DO FILE^DIE(,"APPTFDA","APPTERR")
KILL APPTFDA
+13 QUIT
+14 ;
ORDERCHECKLOCK(ERRORS,APPTIEN,DFN) ;
+1 NEW FOUND,REQUESTIEN,ORDERID,APPTREQTYPE,REQTYPE
+2 SET APPTREQTYPE=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
+3 SET REQUESTIEN=$PIECE($GET(APPTREQTYPE),";")
+4 SET REQTYPE=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
+5 SET FOUND=0
+6 IF REQTYPE="RTC"
Begin DoDot:1
+7 SET ORDERID=$$GET1^DIQ(409.85,REQUESTIEN,46,"I")
+8 IF '+$GET(ORDERID)
QUIT
+9 IF $DATA(^XTMP("ORPTLK-"_DFN))
DO ERRLOG^SDESJSON(.ERRORS,188)
SET FOUND=1
End DoDot:1
+10 QUIT FOUND
+11 ;
VALIDATEAPPTIEN(ERRORS,APPTIEN) ;
+1 IF APPTIEN=""
DO ERRLOG^SDESJSON(.ERRORS,14)
QUIT 0
+2 IF APPTIEN'=""
IF '$DATA(^SDEC(409.84,APPTIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,15)
QUIT 0
+3 QUIT 1
+4 ;
VALIDATECANBY(ERRORS,CANBYCLINORPAT) ;
+1 IF CANBYCLINORPAT=""
DO ERRLOG^SDESJSON(.ERRORS,190)
QUIT 0
+2 IF CANBYCLINORPAT'="C"
IF CANBYCLINORPAT'="PC"
DO ERRLOG^SDESJSON(.ERRORS,189)
QUIT 0
+3 QUIT 1
+4 ;
VALIDATECLINIC(ERRORS,CLINICIEN,APPTIEN) ;
+1 NEW RESOURCEIEN,LINKEDCLINIC
+2 IF CLINICIEN=""
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT 0
+3 IF CLINICIEN'=""
IF '$DATA(^SC(CLINICIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT 0
+4 SET RESOURCEIEN=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
+5 SET LINKEDCLINIC=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
+6 IF CLINICIEN'=LINKEDCLINIC
DO ERRLOG^SDESJSON(.ERRORS,193)
QUIT 0
+7 QUIT 1
+8 ;
VALIDATEDFN(ERRORS,DFN,APPTIEN) ;
+1 IF DFN=""
DO ERRLOG^SDESJSON(.ERRORS,1)
QUIT 0
+2 IF DFN'=""
IF '$DATA(^DPT(DFN,0))
DO ERRLOG^SDESJSON(.ERRORS,2)
QUIT 0
+3 IF $$GET1^DIQ(409.84,APPTIEN,.05,"I")'=DFN
DO ERRLOG^SDESJSON(.ERRORS,194)
QUIT 0
+4 QUIT 1
+5 ;
VALIDATECANREAS(ERRORS,CANCELREASONIEN) ;
+1 IF CANCELREASONIEN=""
DO ERRLOG^SDESJSON(.ERRORS,128)
QUIT 0
+2 IF '$DATA(^SD(409.2,CANCELREASONIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,129)
QUIT 0
+3 QUIT 1
+4 ;
VALIDATENOTE(ERRORS,NOTE,CANCELHASH) ;
+1 NEW SDECJ
+2 ;
SET NOTE=$TRANSLATE($GET(NOTE),"^"," ")
+3 ; Add cancellation comment HASHTAGs from #409.88 to beginning of user note. - 756 wtc 6/8/2020
+4 IF $GET(CANCELHASH)'=""
FOR SDECJ=$LENGTH(CANCELHASH,U):-1:1
SET NOTE=$PIECE(CANCELHASH,U,SDECJ)_"_"_NOTE
+5 IF $EXTRACT(NOTE,$LENGTH(NOTE))="_"
SET NOTE=$EXTRACT(NOTE,1,$LENGTH(NOTE)-1)
+6 QUIT NOTE
+7 ;
VALIDATEEAS(ERRORS,EAS) ;
+1 IF $LENGTH(EAS)
SET EAS=$$EASVALIDATE^SDESUTIL($GET(EAS))
+2 IF $PIECE($GET(EAS),U)=-1
DO ERRLOG^SDESJSON(.ERRORS,142)
QUIT 0
+3 QUIT 1
+4 ;
CANCEL40984(ERRORS,APPTIEN,CANCELREASONIEN,CANBYCLINORPAT,EAS) ;
+1 NEW IENS,FDA40984,ERR84
+2 SET IENS=APPTIEN_","
+3 SET FDA40984(409.84,IENS,.12)=$$NOW^XLFDT
+4 SET FDA40984(409.84,IENS,.121)=DUZ
+5 SET FDA40984(409.84,IENS,.122)=CANCELREASONIEN
+6 SET FDA40984(409.84,IENS,.17)=CANBYCLINORPAT
+7 SET FDA40984(409.84,IENS,100)=EAS
+8 LOCK +^SDEC(APPTIEN):3
IF '$TEST
DO ERRLOG^SDESJSON(.ERRORS,192)
QUIT 0
+9 DO FILE^DIE("","FDA40984","ERR84")
KILL FDA40984
+10 LOCK -^SDEC(APPTIEN)
+11 IF $DATA(ERR84)
DO ERRLOG^SDESJSON(.ERRORS,191)
QUIT 0
+12 QUIT 1
+13 ;
CANCEL44(ERRORS,CLINICIEN,APPTSTARTTIME,DFN,APPTIEN,IENS44) ; FIELD 310 OF 44.003 SET TO "C"
+1 NEW FDA44003,ERR44003,SUBIEN
+2 ;
+3 SET FDA44003(44.003,IENS44,310)="C"
+4 LOCK +^SC(CLINICIEN):3
IF '$TEST
DO ERRLOG^SDESJSON(.ERRORS,186)
DO CLEAN40984(APPTIEN)
QUIT 0
+5 DO FILE^DIE("","FDA44003","ERR44003")
KILL FDA44003
+6 LOCK -^SC(CLINICIEN)
+7 IF $DATA(ERR44003)
DO ERRLOG^SDESJSON(.ERRORS,191)
DO CLEAN40984(APPTIEN)
QUIT 0
+8 QUIT 1
+9 ;
CANCEL2(ERRORS,DFN,APPTSTARTTIME,CANBYCLINORPAT,CANCELREASIONIEN,NOTE,APPTIEN,CLINICIEN,IENS44) ;
+1 NEW IENS,FDA298,ERR298
+2 SET IENS=APPTSTARTTIME_","_DFN_","
+3 SET FDA298(2.98,IENS,3)=CANBYCLINORPAT
+4 SET FDA298(2.98,IENS,14)=DUZ
+5 SET FDA298(2.98,IENS,15)=$$NOW^XLFDT
+6 SET FDA298(2.98,IENS,16)=CANCELREASONIEN
+7 SET FDA298(2.98,IENS,17)=NOTE
+8 LOCK +^DPT(DFN):3
IF '$TEST
DO ERRLOG^SDESJSON(.ERRORS,187)
DO CLEAN40984(APPTIEN)
DO CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44)
QUIT 0
+9 DO FILE^DIE("","FDA298","ERR298")
KILL FDA298
+10 LOCK -^DPT(DFN)
+11 IF $DATA(ERR298)
DO ERRLOG^SDESJSON(.ERRORS,191)
DO CLEAN40984(APPTIEN)
DO CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44)
QUIT 0
+12 QUIT 1
+13 ;
GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN) ;
+1 NEW FOUND,IENS44003
+2 SET FOUND=0
+3 SET SUBIEN=0
FOR
SET SUBIEN=$ORDER(^SC(CLINICIEN,"S",APPTSTARTTIME,1,SUBIEN))
if 'SUBIEN!($GET(FOUND)=1)
QUIT
Begin DoDot:1
+4 IF $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",310,"E")="CANCELLED"
QUIT
+5 IF $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",.01,"I")=DFN
Begin DoDot:2
+6 SET IENS44003=SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_","
SET FOUND=1
QUIT
End DoDot:2
End DoDot:1
+7 QUIT $GET(IENS44003)
+8 ;
CLEAN40984(APPTIEN) ;
+1 NEW FDA40984,IENS,ERR84
+2 SET IENS=APPTIEN_","
+3 SET FDA40984(409.84,IENS,.12)=""
+4 SET FDA40984(409.84,IENS,.121)=""
+5 SET FDA40984(409.84,IENS,.122)=""
+6 SET FDA40984(409.84,IENS,.17)=""
+7 SET FDA40984(409.84,IENS,100)=""
+8 DO FILE^DIE("","FDA40984","ERR84")
KILL FDA40984
+9 QUIT
+10 ;
CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44) ;
+1 NEW FDA44003,ERR44003
+2 ;
+3 SET FDA44003(44.003,IENS44,310)=""
+4 DO FILE^DIE("","FDA44003","ERR44003")
KILL FDA44003
+5 QUIT
+6 ;
BEFOREEVENT(DFN,APPTSTARTTIME,CLINICIEN,SDATA) ;
+1 NEW SDDA,SDCPHDL
+2 SET SDDA=$$SCIEN^SDECU2(DFN,CLINICIEN,APPTSTARTTIME)
+3 SET SDCPHDL=$$HANDLE^SDAMEVT(1)
SET SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
+4 DO BEFORE^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDCPHDL)
+5 QUIT $GET(SDDA)
AFTEREVENT(DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDATA) ;
+1 NEW SDCPHDL
+2 SET SDCPHDL=$$HANDLE^SDAMEVT(1)
+3 SET SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
+4 ;*zeb 10/25/18 722 uncomment to re-enable event driver
DO CANCEL^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,2,SDCPHDL)
+5 QUIT
BUILDJSON(JSONRETURN,RETURN) ;.
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
+3 QUIT
+4 ;
