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

SDESBLOCKANDMOVE.m

Go to the documentation of this file.
SDESBLOCKANDMOVE ;ALB/BLB,LAB - SCHEDULING CANCEL APPOINTMENTS RPC ;DEC 12, 2023
 ;;5.3;Scheduling;**853,866,867**;Aug 13, 1993;Build 8
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 Q
 ;
BLOCKANDMOVE(JSON,BLOCKANDMOVE) ;
 N RETURN,ERRORS,RESOURCEIEN,APPTARRAY,JSONCANCEL,CANCELCLINAVAIL,ORIGINALCLINIC,JSONAPPT,CONTEXT,NEWAPPT
 ;
 ; populate vars
 D POPULATE(.APPTIEN,.TARGETCLINIC,.TARGETDATE,.ORIGINALCLINIC)
 ;
 ; validate Block and Move
 D VALIDATE(.ERRORS,.CONTEXT,$G(APPTIEN),$G(TARGETCLINIC),.TARGETDATE,.RESOURCEIEN)
 I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSON,.RETURN) Q
 ;
 ; cancel original appointment
 D CANAPPT2^SDESCANAPPT2(.JSONCANCEL,APPTIEN,ORIGINALCLINIC,$$GET1^DIQ(409.84,APPTIEN,.05,"I"),"C","BLOCK AND MOVE")
 ;
 ; block availability in original clinic slot
 D CANCLAVAIL^SDESCCAVAIL(.CANCELCLINAVAIL,ORIGINALCLINIC,"P",$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),ORIGINALCLINIC),$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC))
 ;
 ; create new appointment in new slot
 D BUILDAPPTARRAY(.APPTARRAY,TARGETDATE,TARGETCLINIC,APPTIEN)
 D CREATEAPPTS^SDESCRTAPPTWRAP(.JSONAPPT,.APPTARRAY)
 D DECODE^XLFJSON("JSONAPPT","NEWAPPT")
 ;
 S RETURN("BlockAndMoveAppointment","NewAppointmentIEN")=$G(NEWAPPT("Appointment","IEN"))
 D BUILDJSON(.JSON,.RETURN)
 Q
 ;
POPULATE(APPTIEN,TARGETCLINIC,TARGETDATE,ORIGINALCLINIC) ;
 S APPTIEN=$G(BLOCKANDMOVE("APPOINTMENT IEN"))
 S TARGETCLINIC=$G(BLOCKANDMOVE("TARGET CLINIC"))
 S TARGETDATE=$G(BLOCKANDMOVE("TARGET DATE TIME"))
 S ORIGINALCLINIC=$$GET1^DIQ(409.831,$$GET1^DIQ(409.84,$G(APPTIEN),.07,"I"),.04,"I")
 Q
 ;
VALIDATE(ERRORS,CONTEXT,APPTIEN,TARGETCLINIC,TARGETDATE,RESOURCEIEN) ;
 N ORIGINALSLOTS,TARGETSLOTS,SINC,STARTOFDAY,APPTARRAY,ARY84,ARY44,ARY2
 ;
 S RESOURCEIEN=$$GET1^DIQ(409.84,$G(APPTIEN),.07,"I")
 D VALIDATEDATE(.ERRORS,.TARGETDATE,$G(TARGETCLINIC))
 D VALIDATEAPPTIEN(.ERRORS,$G(APPTIEN),$G(TARGETDATE))
 D VALIDATECLINIC(.ERRORS,$G(TARGETCLINIC))
 I $D(ERRORS) Q
 ;
 D PRIVILEGEDUSER(.ERRORS,$G(TARGETCLINIC))
 D VALIDATECLINOPEN(.ERRORS,$G(TARGETCLINIC),$G(TARGETDATE))
 D VALIDATELENGTHS(.ERRORS,RESOURCEIEN,$G(TARGETCLINIC),$G(APPTIEN))
 D VALIDATETARGSLOT(.ERRORS,.TARGETSLOTS,TARGETCLINIC,TARGETDATE,$G(APPTIEN))
 D VALIDATEORIGSLOT(.ERRORS,.ORIGINALSLOTS,$$GET1^DIQ(409.831,$$GET1^DIQ(409.84,$G(APPTIEN),.07,"I"),.04,"I"),$P($$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,$G(APPTIEN),.01,"I")),"T"),$P($$GET1^DIQ(409.84,$G(APPTIEN),.01,"I"),".",2))
 Q
 ;
VALIDATETARGSLOT(ERRORS,TARGETSLOTS,TARGETCLINIC,TARGETSTARTDATE,APPTIEN) ;
 N SLOTS,SLOTNUM,DONE
 D GETCLAVAILABLTY^SDESCLINICAVAIL(.SLOTS,TARGETCLINIC,$$FMTISO^SDAMUTDT(TARGETSTARTDATE),$$FMTISO^SDAMUTDT($P(TARGETSTARTDATE,".")))
 D DECODE^XLFJSON("SLOTS","TARGETSLOTS")
 ;
 S SLOTNUM=0,DONE=0
 S SLOTNUM=$O(TARGETSLOTS("ClinAvail",SLOTNUM)) Q:'SLOTNUM!(DONE=1)  D
 .I $G(TARGETSLOTS("ClinAvail",SLOTNUM,"BeginTime"))=$$FMTISO^SDAMUTDT(TARGETSTARTDATE) D
 ..I '$G(TARGETSLOTS("ClinAvail",SLOTNUM,"SlotsAvail")) D ERRLOG^SDESJSON(.ERRORS,470) S DONE=1 Q
 Q
 ;
VALIDATEORIGSLOT(ERRORS,ORIGINALSLOTS,ORIGINALCLINIC,APPTDATE,APPTSTARTTIME) ;
 N SLOTS,COUNT,SLOTNUM,DONE
 D GETSCHEDULE^SDESCLINDAILYSCH(.ORIGINALSLOTS,ORIGINALCLINIC,APPTDATE)
 D DECODE^XLFJSON("ORIGINALSLOTS","SLOTS")
 S SLOTNUM=0,DONE=0,COUNT=1
 F  S SLOTNUM=$O(SLOTS("ClinicSlot",SLOTNUM)) Q:'SLOTNUM!(DONE=1)  D
 .I $G(SLOTS("ClinicSlot",SLOTNUM,"StartTime"))=$E(APPTSTARTTIME_"0000",1,4) D
 ..I $G(SLOTS("ClinicSlot",SLOTNUM,"OpenSlots"))>1 D ERRLOG^SDESJSON(.ERRORS,468) S DONE=1 Q
 I $$GET1^DIQ(44.003,$$GET44RECORDIENS^SDESCANAPPT2(ORIGINALCLINIC,$$GET1^DIQ(409.84,APPTIEN,.01,"I"),$$GET1^DIQ(409.84,APPTIEN,.05,"I")),9,"E")="OVERBOOK" D ERRLOG^SDESJSON(.ERRORS,469)
 Q
 ;
VALIDATEAPPTIEN(ERRORS,APPTIEN,TARGETDATE) ;
 I APPTIEN="" D ERRLOG^SDESJSON(.ERRORS,14) Q
 I APPTIEN'="",'$D(^SDEC(409.84,APPTIEN,0)) D ERRLOG^SDESJSON(.ERRORS,15) Q
 I $P($$GET1^DIQ(409.84,APPTIEN,.01,"I"),".")'=$P($$GET1^DIQ(409.84,APPTIEN,.02,"I"),".") D ERRLOG^SDESJSON(.ERRORS,462) Q
 I $$GET1^DIQ(409.84,APPTIEN,.12,"I")!($$GET1^DIQ(409.84,APPTIEN,.03,"I"))!($$GET1^DIQ(409.84,APPTIEN,.14,"I"))!($$GET1^DIQ(409.84,APPTIEN,.101,"I")) D ERRLOG^SDESJSON(.ERRORS,463)
 Q
 ;
VALIDATECLINIC(ERRORS,TARGETCLINIC) ;
 I TARGETCLINIC="" D ERRLOG^SDESJSON(.ERRORS,18) Q
 I TARGETCLINIC'="",'$D(^SC(TARGETCLINIC,0)) D ERRLOG^SDESJSON(.ERRORS,19) Q
 Q
 ;
VALIDATECLINOPEN(ERRORS,TARGETCLINIC,TARGETDATE) ;
 N TIMECLINICOPENS
 S TIMECLINICOPENS=$$GET1^DIQ(44,TARGETCLINIC,1914,"I")
 I TIMECLINICOPENS="" S TIMECLINICOPENS=8
 ;
 I +$E($P(TARGETDATE,".",2)_"0000",1,4)<TIMECLINICOPENS D ERRLOG^SDESJSON(.ERRORS,344)
 I '$G(^SC(TARGETCLINIC,"ST",$P(TARGETDATE,"."),0)) D ERRLOG^SDESJSON(.ERRORS,466)
 Q
 ;
VALIDATELENGTHS(ERRORS,RESOURCEIEN,TARGETCLINIC,APPTIEN) ;
 I $$GET1^DIQ(44,TARGETCLINIC,1912)'=$$GET1^DIQ(44,$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I"),1912) D ERRLOG^SDESJSON(.ERRORS,500)
 I $$GET1^DIQ(409.84,APPTIEN,.18,"I")'=$$GET1^DIQ(44,$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I"),1912) D ERRLOG^SDESJSON(.ERRORS,507)
 Q
 ;
PRIVILEGEDUSER(ERRORS,TARGETCLINIC) ;
 I $$GET1^DIQ(44,TARGETCLINIC,2500,"I")="Y" D
 .I '$D(^SC(TARGETCLINIC,"SDPRIV",DUZ,0)) D ERRLOG^SDESJSON(.ERRORS,343)
 Q
 ;
VALIDATEDATE(ERRORS,DATE,CLINICIEN) ;
 I DATE="" D ERRLOG^SDESJSON(.ERRORS,9) Q
 S DATE=$$ISOTFM^SDAMUTDT(DATE)
 I DATE=-1 D ERRLOG^SDESJSON(.ERRORS,11) Q
 I '$P(DATE,".",2) D ERRLOG^SDESJSON(.ERRORS,511) Q
 ; cant schedule on holiday if clinic does not allow
 I $$GET1^DIQ(44,CLINICIEN,1918.5,"I")'="Y",$D(^HOLIDAY($P(DATE,"."),0)) D ERRLOG^SDESJSON(.ERRORS,465)
 Q
 ;
BUILDJSON(JSON,CANRETURN) ;.
 N JSONERROR
 D ENCODE^XLFJSON("CANRETURN","JSON","JSONERR")
 Q
 ;
BUILDAPPTARRAY(APPTARRAY,TARGETDATE,TARGETCLINIC,APPTIEN) ;
 N ORIGINALAPPT
 D GETS^DIQ(409.84,APPTIEN,"*","ZI","ORIGINALAPPT")
 ;
 S APPTARRAY(1)=$$FMTISO^SDAMUTDT(TARGETDATE)
 S APPTARRAY(2)=$$FMTISO^SDAMUTDT($$FMADD^XLFDT(TARGETDATE,,,$$GET1^DIQ(409.84,APPTIEN,.18,"I")))
 S APPTARRAY(3)=$G(ORIGINALAPPT(409.84,APPTIEN_",",.05,"I"))
 S APPTARRAY(4)=$$GETRES^SDESINPUTVALUTL(TARGETCLINIC,1)
 S APPTARRAY(5)=""
 S APPTARRAY(6)=$$FMTISO^SDAMUTDT($G(ORIGINALAPPT(409.84,APPTIEN_",",.2,"I")))
 S APPTARRAY(7)=""
 S APPTARRAY(8)=$E($$GET1^DIQ(409.84,APPTIEN,.22,"E"),1,1)_"|"_$P($G(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";",1)
 S APPTARRAY(9)=$G(ORIGINALAPPT(409.84,APPTIEN_",",.16,"I"))
 S APPTARRAY(10)=TARGETCLINIC
 S APPTARRAY(11)=$G(ORIGINALAPPT(409.84,APPTIEN_",",.1,"I"))
 S APPTARRAY(12.5)=$$GET1^DIQ(409.1,$G(ORIGINALAPPT(409.84,APPTIEN_",",.06,"I")),.01,"E")
 S APPTARRAY(13)=$G(ORIGINALAPPT(409.84,APPTIEN_",",.23,"I"))
 S APPTARRAY(14)=$G(ORIGINALAPPT(409.84,APPTIEN_",",.18,"I"))
 S APPTARRAY(15)=""
 S APPTARRAY(16)=""
 I $$GET1^DIQ(409.85,$P($G(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8) D
 .S APPTARRAY(17)="TRUE"
 .S APPTARRAY(18)=$$GET1^DIQ(409.85,$P($G(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8)
 S APPTARRAY(19)=$G(ORIGINALAPPT(409.84,APPTIEN_",",100,"I"))
 S APPTARRAY(20)=""
 S APPTARRAY(21)=""
 S APPTARRAY(22)=""
 S APPTARRAY(23)=""
 S APPTARRAY(24)=""
 S APPTARRAY(25)=""
 S APPTARRAY(26)=3
 S APPTARRAY(27)=""
 S APPTARRAY(28)="P"
 S APPTARRAY(29)=0
 S APPTARRAY(30)=""
 Q
 ;