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

SDESCANCELAPPTS.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  ;Cancel appointments in files 409.84, 44, 2.
  1.  ;
  1.  ;APPTIEN - (required) pointer to SDEC APPOINTMENT file #409.84
  1.  ;CLINICIEN -(required) pointer to hospital location file #44
  1.  ;DFN -(required) pointer to patient file #2
  1.  ;CANBYCLINORPAT   - (required) appointment Status valid values: C=CANCELLED BY CLINIC ; PC=CANCELLED BY PATIENT
  1.  ;CANCELREASONIEN    - (required) pointer to CANCELLATION REASON File (409.2)
  1.  ;NOTE   - (optional) text representing user note
  1.  ;CANCELHASH   - (optional) List of cancellation comment hash tags (see #409.88) separated by ^
  1.  ;EAS - (optional) Enterprise Appointment Scheduling Tracking Number associated to an appointment.
  1.  ;
  1.  Q
  1.  ;
  1. CANCELAPPTS(JSONRETURN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,CANCELREASONIEN,NOTE,CANCELHASH,EAS) ;
  1.  N ERRORS,ISAPPTIENVALID,ORDERLOCK,ISCANBYVALID,ISCANREASONVALID,ISDFNVALID,SDATA,ISCLINICVALID,APPTENDTIME,APPTSTARTTIME,PROVIEN
  1.  N ISEASVALID,ISCANBYVALID,ISNOTEVALID,ISCANDTTMVALID,EDITED,CLINICSUBIEN,IS2CANCELLED,IS40984CANCELLED,IS44CANCELLED,REQUESTTYPE,REQUESTIEN
  1.  N RECALLREQIEN,RECALLREQLINK,RESOURCE,OLDRECALLPTR,RETURN,RECALLRET,APPTLENGTH,IENS44
  1.  ;
  1.  S ORDERLOCK=$$ORDERCHECKLOCK(.ERRORS,$G(APPTIEN),$G(DFN))
  1.  I ORDERLOCK M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
  1.  ;
  1.  S ISAPPTIENVALID=$$VALIDATEAPPTIEN(.ERRORS,$G(APPTIEN))
  1.  ;
  1.  S ISCLINICVALID=$$VALIDATECLINIC(.ERRORS,$G(CLINICIEN),$G(APPTIEN))
  1.  ;
  1.  S ISDFNVALID=$$VALIDATEDFN(.ERRORS,$G(DFN),$G(APPTIEN))
  1.  ;
  1.  S ISCANBYVALID=$$VALIDATECANBY(.ERRORS,$G(CANBYCLINORPAT))
  1.  ;
  1.  S ISCANREASONVALID=$$VALIDATECANREAS(.ERRORS,$G(CANCELREASONIEN))
  1.  ;
  1.  S NOTE=$$VALIDATENOTE(.ERRORS,$G(NOTE),$G(CANCELHASH))
  1.  ;
  1.  S ISEASVALID=$$VALIDATEEAS(.ERRORS,$G(EAS))
  1.  ;
  1.  I $D(ERRORS) S ERRORS("Appointment",1)="" M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
  1.  ;
  1.  ;
  1.  ; cancel appointments
  1.  ;
  1.  S APPTSTARTTIME=$$GET1^DIQ(409.84,$G(APPTIEN),.01,"I")
  1.  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:"")
  1.  S REQUESTIEN=$P($$GET1^DIQ(409.84,$G(APPTIEN),.22,"I"),";")
  1.  S APPTENDTIME=$$GET1^DIQ(409.84,$G(APPTIEN),.02,"I")
  1.  S RESOURCE=$$GET1^DIQ(409.84,$G(APPTIEN),.07,"I")
  1.  S IENS44=$$GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN)
  1.  ;
  1.  S CLINICSUBIEN=$$BEFOREEVENT($G(DFN),$G(APPTSTARTTIME),$G(CLINICIEN),.SDATA)
  1.  ;
  1.  S IS40984CANCELLED=$$CANCEL40984(.ERRORS,$G(APPTIEN),$G(CANCELREASONIEN),$G(CANBYCLINORPAT),$G(EAS))
  1.  ;
  1.  S IS44CANCELLED=$$CANCEL44(.ERRORS,$G(CLINICIEN),$G(APPTSTARTTIME),$G(DFN),$G(APPTIEN),$G(IENS44))
  1.  ;
  1.  S IS2CANCELLED=$$CANCEL2(.ERRORS,$G(DFN),$G(APPTSTARTTIME),$G(CANBYCLINORPAT),$G(CANCELREASONIEN),$G(NOTE),$G(APPTIEN),$G(CLINICIEN),$G(IENS44))
  1.  ;
  1.  I $D(ERRORS) S ERRORS("Appointment",1)="" M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
  1.  ;
  1.  I REQUESTTYPE="APPTREQ" D
  1.  .D OPENAPPTREQUEST^SDESCANAPPT2(REQUESTIEN,$G(APPTIEN))
  1.  .D DELETEAPPTDATA(REQUESTIEN)
  1.  .D REMOVEMRTCAPTIEN^SDESCANAPPT2(REQUESTIEN,APPTIEN)
  1.  .; update contact main sequence upon re-open
  1.  .D UPDCONTSEQ^SDESCONTACTS($G(DFN),$G(REQUESTIEN))
  1.  ;
  1.  I REQUESTTYPE="RECALL" D
  1.  .D REOPEN^SDESRECALLREQ(.RECALLRET,$G(APPTIEN),,,CANBYCLINORPAT)
  1.  .S RECALLREQIEN=$P(RECALLRET,U)
  1.  .S RECALLREQLINK=$P(RECALLRET,U,2)
  1.  .S OLDRECALLPTR=$P(RECALLRET,U,3)
  1.  .; update contact main sequence upon re-open
  1.  .D UPDCONTSEQ^SDESCONTACTS($G(DFN),$G(RECALLREQIEN),$G(RECALLREQLINK),$G(OLDRECALLPTR))
  1.  ;
  1.  I REQUESTTYPE="CONSULT" D
  1.  .S PROVIEN=$$GET1^DIQ(44,CLINICIEN,16,"I")
  1.  .D REQSET^SDESCONSULTUPD(REQUESTIEN,PROVIEN,"",2,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE)
  1.  .; update contact main sequence upon re-open
  1.  .D UPDCONTSEQ^SDESCONTACTS($G(DFN),$G(REQUESTIEN))
  1.  ;
  1.  S APPTLENGTH=$$GET1^DIQ(409.84,APPTIEN,.18,"I")
  1.  D AVUPDT^SDEC08A(CLINICIEN,APPTSTARTTIME,APPTLENGTH)
  1.  D AFTEREVENT($G(DFN),$G(APPTSTARTTIME),$G(CLINICIEN),$G(CLINICSUBIEN),.SDATA)
  1.  ;
  1.  ; Update AMIE C&P EXAM TRACKING (#396.95) record if this appointment is a Compensation and Pension appointment
  1.  I $$GET1^DIQ(409.84,APPTIEN,.06,"E")="COMPENSATION & PENSION" D AMIECAN^SDESCOMPPEN(.RETURN,DFN,APPTSTARTTIME)
  1.  ;
  1.  S RETURN("Appointment","Cancelled")=$G(APPTIEN)
  1.  D BUILDJSON(.JSONRETURN,.RETURN) Q
  1.  Q
  1.  ;
  1. OPENAPPTREQUEST(REQUESTIEN,APPTIEN) ;
  1.  N CANCELREASON,REQUESTFDA,REQUESTERR
  1.  S REQUESTIEN=REQUESTIEN_","
  1.  S REQUESTFDA(409.85,REQUESTIEN,19)=""
  1.  S REQUESTFDA(409.85,REQUESTIEN,20)=""
  1.  S REQUESTFDA(409.85,REQUESTIEN,21)=""
  1.  S CANCELREASON=$$GET1^DIQ(409.84,APPTIEN,.122,"I")
  1.  ; does cancel reason allow request to re-open
  1.  I $$GET1^DIQ(409.2,CANCELREASON,5,"I")'=0 D
  1.  .S REQUESTFDA(409.85,REQUESTIEN,23)="OPEN"
  1.  D FILE^DIE("","REQUESTFDA","REQUESTERR") K REQUESTFDA
  1.  Q
  1.  ;
  1. DELETEAPPTDATA(REQUESTIEN) ;
  1.  N APPTFDA,APPTERR
  1.  S REQUESTIEN=$G(REQUESTIEN)_","
  1.  S APPTFDA(409.85,REQUESTIEN,13)="@"
  1.  S APPTFDA(409.85,REQUESTIEN,13.1)="@"
  1.  S APPTFDA(409.85,REQUESTIEN,13.2)="@"
  1.  S APPTFDA(409.85,REQUESTIEN,13.3)="@"
  1.  S APPTFDA(409.85,REQUESTIEN,13.4)="@"
  1.  S APPTFDA(409.85,REQUESTIEN,13.6)="@"
  1.  S APPTFDA(409.85,REQUESTIEN,13.7)="@"
  1.  S APPTFDA(409.85,REQUESTIEN,13.8)="@"
  1.  S APPTFDA(409.85,REQUESTIEN,100)=$G(EAS)
  1.  D FILE^DIE(,"APPTFDA","APPTERR") K APPTFDA
  1.  Q
  1.  ;
  1. ORDERCHECKLOCK(ERRORS,APPTIEN,DFN) ;
  1.  N FOUND,REQUESTIEN,ORDERID,APPTREQTYPE,REQTYPE
  1.  S APPTREQTYPE=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
  1.  S REQUESTIEN=$P($G(APPTREQTYPE),";")
  1.  S REQTYPE=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
  1.  S FOUND=0
  1.  I REQTYPE="RTC" D
  1.  .S ORDERID=$$GET1^DIQ(409.85,REQUESTIEN,46,"I")
  1.  .I '+$G(ORDERID) Q
  1.  .I $D(^XTMP("ORPTLK-"_DFN)) D ERRLOG^SDESJSON(.ERRORS,188) S FOUND=1
  1.  Q FOUND
  1.  ;
  1. VALIDATEAPPTIEN(ERRORS,APPTIEN) ;
  1.  I APPTIEN="" D ERRLOG^SDESJSON(.ERRORS,14) Q 0
  1.  I APPTIEN'="",'$D(^SDEC(409.84,APPTIEN,0)) D ERRLOG^SDESJSON(.ERRORS,15) Q 0
  1.  Q 1
  1.  ;
  1. VALIDATECANBY(ERRORS,CANBYCLINORPAT) ;
  1.  I CANBYCLINORPAT="" D ERRLOG^SDESJSON(.ERRORS,190) Q 0
  1.  I CANBYCLINORPAT'="C",CANBYCLINORPAT'="PC" D ERRLOG^SDESJSON(.ERRORS,189) Q 0
  1.  Q 1
  1.  ;
  1. VALIDATECLINIC(ERRORS,CLINICIEN,APPTIEN) ;
  1.  N RESOURCEIEN,LINKEDCLINIC
  1.  I CLINICIEN="" D ERRLOG^SDESJSON(.ERRORS,18) Q 0
  1.  I CLINICIEN'="",'$D(^SC(CLINICIEN,0)) D ERRLOG^SDESJSON(.ERRORS,19) Q 0
  1.  S RESOURCEIEN=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
  1.  S LINKEDCLINIC=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
  1.  I CLINICIEN'=LINKEDCLINIC D ERRLOG^SDESJSON(.ERRORS,193) Q 0
  1.  Q 1
  1.  ;
  1. VALIDATEDFN(ERRORS,DFN,APPTIEN) ;
  1.  I DFN="" D ERRLOG^SDESJSON(.ERRORS,1) Q 0
  1.  I DFN'="",'$D(^DPT(DFN,0)) D ERRLOG^SDESJSON(.ERRORS,2) Q 0
  1.  I $$GET1^DIQ(409.84,APPTIEN,.05,"I")'=DFN D ERRLOG^SDESJSON(.ERRORS,194) Q 0
  1.  Q 1
  1.  ;
  1. VALIDATECANREAS(ERRORS,CANCELREASONIEN) ;
  1.  I CANCELREASONIEN="" D ERRLOG^SDESJSON(.ERRORS,128) Q 0
  1.  I '$D(^SD(409.2,CANCELREASONIEN,0)) D ERRLOG^SDESJSON(.ERRORS,129) Q 0
  1.  Q 1
  1.  ;
  1. VALIDATENOTE(ERRORS,NOTE,CANCELHASH) ;
  1.  N SDECJ
  1.  S NOTE=$TR($G(NOTE),"^"," ") ;
  1.  ;  Add cancellation comment HASHTAGs from #409.88 to beginning of user note. - 756 wtc 6/8/2020
  1.  I $G(CANCELHASH)'="" F SDECJ=$L(CANCELHASH,U):-1:1 S NOTE=$P(CANCELHASH,U,SDECJ)_"_"_NOTE
  1.  I $E(NOTE,$L(NOTE))="_" S NOTE=$E(NOTE,1,$L(NOTE)-1)
  1.  Q NOTE
  1.  ;
  1. VALIDATEEAS(ERRORS,EAS) ;
  1.  I $L(EAS) S EAS=$$EASVALIDATE^SDESUTIL($G(EAS))
  1.  I $P($G(EAS),U)=-1 D ERRLOG^SDESJSON(.ERRORS,142) Q 0
  1.  Q 1
  1.  ;
  1. CANCEL40984(ERRORS,APPTIEN,CANCELREASONIEN,CANBYCLINORPAT,EAS) ;
  1.  N IENS,FDA40984,ERR84
  1.  S IENS=APPTIEN_","
  1.  S FDA40984(409.84,IENS,.12)=$$NOW^XLFDT
  1.  S FDA40984(409.84,IENS,.121)=DUZ
  1.  S FDA40984(409.84,IENS,.122)=CANCELREASONIEN
  1.  S FDA40984(409.84,IENS,.17)=CANBYCLINORPAT
  1.  S FDA40984(409.84,IENS,100)=EAS
  1.  L +^SDEC(APPTIEN):3 I '$T D ERRLOG^SDESJSON(.ERRORS,192) Q 0
  1.  D FILE^DIE("","FDA40984","ERR84") K FDA40984
  1.  L -^SDEC(APPTIEN)
  1.  I $D(ERR84) D ERRLOG^SDESJSON(.ERRORS,191) Q 0
  1.  Q 1
  1.  ;
  1. CANCEL44(ERRORS,CLINICIEN,APPTSTARTTIME,DFN,APPTIEN,IENS44) ; FIELD 310 OF 44.003 SET TO "C"
  1.  N FDA44003,ERR44003,SUBIEN
  1.  ;
  1.  S FDA44003(44.003,IENS44,310)="C"
  1.  L +^SC(CLINICIEN):3 I '$T D ERRLOG^SDESJSON(.ERRORS,186),CLEAN40984(APPTIEN) Q 0
  1.  D FILE^DIE("","FDA44003","ERR44003") K FDA44003
  1.  L -^SC(CLINICIEN)
  1.  I $D(ERR44003) D ERRLOG^SDESJSON(.ERRORS,191) D CLEAN40984(APPTIEN) Q 0
  1.  Q 1
  1.  ;
  1. CANCEL2(ERRORS,DFN,APPTSTARTTIME,CANBYCLINORPAT,CANCELREASIONIEN,NOTE,APPTIEN,CLINICIEN,IENS44) ;
  1.  N IENS,FDA298,ERR298
  1.  S IENS=APPTSTARTTIME_","_DFN_","
  1.  S FDA298(2.98,IENS,3)=CANBYCLINORPAT
  1.  S FDA298(2.98,IENS,14)=DUZ
  1.  S FDA298(2.98,IENS,15)=$$NOW^XLFDT
  1.  S FDA298(2.98,IENS,16)=CANCELREASONIEN
  1.  S FDA298(2.98,IENS,17)=NOTE
  1.  L +^DPT(DFN):3 I '$T D ERRLOG^SDESJSON(.ERRORS,187),CLEAN40984(APPTIEN),CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44) Q 0
  1.  D FILE^DIE("","FDA298","ERR298") K FDA298
  1.  L -^DPT(DFN)
  1.  I $D(ERR298) D ERRLOG^SDESJSON(.ERRORS,191),CLEAN40984(APPTIEN),CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44) Q 0
  1.  Q 1
  1.  ;
  1. GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN) ;
  1.  N FOUND,IENS44003
  1.  S FOUND=0
  1.  S SUBIEN=0 F  S SUBIEN=$O(^SC(CLINICIEN,"S",APPTSTARTTIME,1,SUBIEN)) Q:'SUBIEN!($G(FOUND)=1)  D
  1.  .I $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",310,"E")="CANCELLED" Q
  1.  .I $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",.01,"I")=DFN D
  1.  ..S IENS44003=SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",FOUND=1 Q
  1.  Q $G(IENS44003)
  1.  ;
  1. CLEAN40984(APPTIEN) ;
  1.  N FDA40984,IENS,ERR84
  1.  S IENS=APPTIEN_","
  1.  S FDA40984(409.84,IENS,.12)=""
  1.  S FDA40984(409.84,IENS,.121)=""
  1.  S FDA40984(409.84,IENS,.122)=""
  1.  S FDA40984(409.84,IENS,.17)=""
  1.  S FDA40984(409.84,IENS,100)=""
  1.  D FILE^DIE("","FDA40984","ERR84") K FDA40984
  1.  Q
  1.  ;
  1. CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44) ;
  1.  N FDA44003,ERR44003
  1.  ;
  1.  S FDA44003(44.003,IENS44,310)=""
  1.  D FILE^DIE("","FDA44003","ERR44003") K FDA44003
  1.  Q
  1.  ;
  1. BEFOREEVENT(DFN,APPTSTARTTIME,CLINICIEN,SDATA) ;
  1.  N SDDA,SDCPHDL
  1.  S SDDA=$$SCIEN^SDECU2(DFN,CLINICIEN,APPTSTARTTIME)
  1.  S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
  1.  D BEFORE^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDCPHDL)
  1.  Q $G(SDDA)
  1. AFTEREVENT(DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDATA) ;
  1.  N SDCPHDL
  1.  S SDCPHDL=$$HANDLE^SDAMEVT(1)
  1.  S SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
  1.  D CANCEL^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,2,SDCPHDL)  ;*zeb 10/25/18 722 uncomment to re-enable event driver
  1.  Q
  1. BUILDJSON(JSONRETURN,RETURN) ;.
  1.  N JSONERROR
  1.  D ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
  1.  Q
  1.  ;