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

SDES2BLOCKMOVE.m

Go to the documentation of this file. 
  1. SDES2BLOCKMOVE ;ALB/TJB - SCHEDULING BLOCK AND MOVE RPC ;JAN 22, 2024
  1.  ;;5.3;Scheduling;**871**;Aug 13, 1993;Build 13
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  Q
  1.  ;
  1. BLOCKANDMOVE(JSON,SDCONTEXT,SDPARAM) ;
  1.  N RETURN,ERRORS,BLKPARAM,AVPARAM,DFN,SDDUZ,RESOURCEIEN,APPTARRAY,JSONCANCEL,CANCELCLINAVAIL,ORIGINALCLINIC,JSONAPPT,NEWAPPT
  1.  ;
  1.  D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
  1.  ; populate vars
  1.  S SDDUZ=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
  1.  D POPULATE(.BLKPARAM,.AVPARAM,.SDPARAM,SDDUZ)
  1.  ;
  1.  ; validate Block and Move
  1.  D VALIDATE(.ERRORS,.BLKPARAM,SDDUZ)
  1.  I $D(ERRORS) S RETURN("BlockAndMoveAppointment")="" M RETURN=ERRORS D BUILDJSON^SDES2JSON(.JSON,.RETURN) Q
  1.  ; cancel original appointment
  1.  D CANCEL(.JSONCANCEL,.BLKPARAM,.SDCONTEXT)
  1.  ;
  1.  ; block availability in original clinic slot
  1.  D CANCELAVAIL(.CANCELCLINAVAIL,.SDCONTEXT,.AVPARAM)
  1.  ;
  1.  ; create new appointment in new slot
  1.  D BUILDAPPTARRAY(.APPTARRAY,.BLKPARAM)
  1.  D CREATE^SDES2CREATEAPPT(.JSONAPPT,.SDCONTEXT,.APPTARRAY)
  1.  D DECODE^XLFJSON("JSONAPPT","NEWAPPT")
  1.  ;
  1.  S RETURN("BlockAndMoveAppointment","NewAppointmentIEN")=$G(NEWAPPT("Appointment","IEN"))
  1.  D BUILDJSON^SDES2JSON(.JSON,.RETURN)
  1.  Q
  1.  ;
  1. POPULATE(PARAMS,AVPARAMS,SDPARAM,SDDUZ) ;
  1.  N APPTIEN,RESOURCEIEN
  1.  S APPTIEN=$G(SDPARAM("APPOINTMENT IEN"))
  1.  S RESOURCEIEN=$$GET1^DIQ(409.84,$G(APPTIEN),.07,"I")
  1.  S PARAMS("APPT IEN")=APPTIEN
  1.  S PARAMS("RESOURCE IEN")=RESOURCEIEN
  1.  S PARAMS("CLINIC IEN")=$$GET1^DIQ(409.831,$G(RESOURCEIEN),.04,"I")
  1.  S PARAMS("TARGET CLINIC IEN")=$G(SDPARAM("TARGET CLINIC"))
  1.  S PARAMS("TARGET DATE TIME")=$G(SDPARAM("TARGET DATE TIME")) ; ISO Format
  1.  S PARAMS("DFN")=$$GET1^DIQ(409.84,$G(APPTIEN),.05,"I")
  1.  S PARAMS("CANCELLED BY")="C"
  1.  S PARAMS("CANCEL REASON")="BLOCK AND MOVE"
  1.  S PARAMS("CANCEL REASON IEN")=$O(^SD(409.2,"B",PARAMS("CANCEL REASON"),0))
  1.  S PARAMS("ORIGINAL USER")=$S($G(SDDUZ)'="":SDDUZ,1:DUZ)
  1.  S AVPARAM("CLINIC IEN")=PARAMS("CLINIC IEN")
  1.  S AVPARAM("START DATE TIME")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),$G(PARAMS("CLINIC IEN")))
  1.  S AVPARAM("END DATE TIME")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),$G(PARAMS("CLINIC IEN")))
  1.  S AVPARAM("FULL PARTIAL FLAG")="P"
  1.  S AVPARAM("REMARKS")="For BLOCK AND MOVE"
  1.  Q
  1.  ;
  1.  ; CANCEL(RETURN,APPTIEN,ORIGINALCLINIC,DFN,CANCELBY,CANREASON,NOTE) ;
  1. CANCEL(RETURN,PARAMS,SDCONTEXT) ;
  1.  N SDRETURN,SDERRORS
  1.  ; ** Required Parameters **
  1.  ; PARAMS("APPT IEN") = IEN of SDEC APPOINTMENT (#409.84) file record to be Cancelled
  1.  ; PARAMS("CLINIC IEN") = Pointer to the HOSPITAL LOCATION (#44) file
  1.  ; PARAMS("DFN") = Pointer to the PATIENT (#2) file
  1.  ; PARAMS("CANCELLED BY") - Appt Cancelled By: C=CANCELLED BY CLINIC ; PC=CANCELLED BY PATIENT
  1.  ; PARAMS("CANCEL REASON") - Cancellation Reason NAME in the CANCELLATION REASON (#409.2) file
  1.  ; PARAMS("NOTE") - Comments related to the cancellation (optional)
  1.  ;
  1.  D TRY2CANCEL^SDES2CANCELAPPT(.SDRETURN,.SDCONTEXT,.PARAMS,.SDERRORS)
  1.  I $D(SDERRORS) M RETURN=SDERRORS
  1.  I '$D(SDERRORS) M RETURN=SDRETURN
  1.  Q
  1.  ;
  1. CANCELAVAIL(CANAVAIL,SDCONTEXT,AVPARAMS) ;
  1.  N CANCAVJSON,DECDATA
  1.  ;
  1.  D CANCEL^SDES2CANCLNAVAIL(.CANCAVJSON,.SDCONTEXT,.AVPARAMS)
  1.  M CANAVAIL=CANCAVJSON
  1.  Q
  1.  ;
  1. VALIDATE(ERRORS,CONTEXT,SDDUZ) ;
  1.  N ORIGINALSLOTS,TARGETDATE,TARGETSLOTS,SINC,STARTOFDAY,APPTARRAY,ARY84,ARY44,ARY2
  1.  ;
  1.  S APPTIEN=$G(CONTEXT("APPT IEN"))
  1.  S TARGETDATE=$G(CONTEXT("TARGET DATE TIME"))
  1.  S TARGETCLINIC=$G(CONTEXT("TARGET CLINIC IEN"))
  1.  D VALIDATEDATE(.ERRORS,.TARGETDATE,TARGETCLINIC)
  1.  D VALIDATEAPPTIEN(.ERRORS,APPTIEN,TARGETDATE)
  1.  D VALIDATECLINIC(.ERRORS,TARGETCLINIC)
  1.  I $D(ERRORS) Q
  1.  ;
  1.  D PRIVILEGEDUSER(.ERRORS,TARGETCLINIC,SDDUZ)
  1.  D VALIDATECLINOPEN(.ERRORS,TARGETCLINIC,TARGETDATE)
  1.  D VALIDATELENGTHS(.ERRORS,$G(CONTEXT("RESOURCE IEN")),TARGETCLINIC,APPTIEN)
  1.  D VALIDATETARGSLOT(.ERRORS,.TARGETSLOTS,TARGETCLINIC,TARGETDATE,APPTIEN)
  1.  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))
  1.  Q
  1.  ;
  1. VALIDATETARGSLOT(ERRORS,TARGETSLOTS,TARGETCLINIC,TARGETSTARTDATE,APPTIEN) ;
  1.  N SLOTS,SLOTNUM,DONE
  1.  D GETCLAVAILABLTY^SDESCLINICAVAIL(.SLOTS,TARGETCLINIC,$$FMTISO^SDAMUTDT(TARGETSTARTDATE),$$FMTISO^SDAMUTDT($P(TARGETSTARTDATE,".")))
  1.  D DECODE^XLFJSON("SLOTS","TARGETSLOTS")
  1.  ;
  1.  S SLOTNUM=0,DONE=0
  1.  S SLOTNUM=$O(TARGETSLOTS("ClinAvail",SLOTNUM)) Q:'SLOTNUM!(DONE=1)  D
  1.  .I $G(TARGETSLOTS("ClinAvail",SLOTNUM,"BeginTime"))=$$FMTISO^SDAMUTDT(TARGETSTARTDATE) D
  1.  ..I '$G(TARGETSLOTS("ClinAvail",SLOTNUM,"SlotsAvail")) D ERRLOG^SDES2JSON(.ERRORS,470) S DONE=1 Q
  1.  Q
  1.  ;
  1. VALIDATEORIGSLOT(ERRORS,ORIGINALSLOTS,ORIGINALCLINIC,APPTDATE,APPTSTARTTIME) ;
  1.  N SLOTS,COUNT,SLOTNUM,DONE
  1.  D GETSCHEDULE^SDESCLINDAILYSCH(.ORIGINALSLOTS,ORIGINALCLINIC,APPTDATE)
  1.  D DECODE^XLFJSON("ORIGINALSLOTS","SLOTS")
  1.  S SLOTNUM=0,DONE=0,COUNT=1
  1.  F  S SLOTNUM=$O(SLOTS("ClinicSlot",SLOTNUM)) Q:'SLOTNUM!(DONE=1)  D
  1.  .I $G(SLOTS("ClinicSlot",SLOTNUM,"StartTime"))=$E(APPTSTARTTIME_"0000",1,4) D
  1.  ..I $G(SLOTS("ClinicSlot",SLOTNUM,"OpenSlots"))>1 D ERRLOG^SDES2JSON(.ERRORS,468) S DONE=1 Q
  1.  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^SDES2JSON(.ERRORS,469)
  1.  Q
  1.  ;
  1. VALIDATEAPPTIEN(ERRORS,APPTIEN,TARGETDATE) ;
  1.  I APPTIEN="" D ERRLOG^SDES2JSON(.ERRORS,14) Q
  1.  I APPTIEN'="",'$D(^SDEC(409.84,APPTIEN,0)) D ERRLOG^SDES2JSON(.ERRORS,15) Q
  1.  I $P($$GET1^DIQ(409.84,APPTIEN,.01,"I"),".")'=$P($$GET1^DIQ(409.84,APPTIEN,.02,"I"),".") D ERRLOG^SDES2JSON(.ERRORS,462) Q
  1.  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^SDES2JSON(.ERRORS,463)
  1.  Q
  1.  ;
  1. VALIDATECLINIC(ERRORS,TARGETCLINIC) ;
  1.  I TARGETCLINIC="" D ERRLOG^SDES2JSON(.ERRORS,18) Q
  1.  I TARGETCLINIC'="",'$D(^SC(TARGETCLINIC,0)) D ERRLOG^SDES2JSON(.ERRORS,19) Q
  1.  Q
  1.  ;
  1. VALIDATECLINOPEN(ERRORS,TARGETCLINIC,TARGETDATE) ;
  1.  N TIMECLINICOPENS
  1.  S TIMECLINICOPENS=$$GET1^DIQ(44,TARGETCLINIC,1914,"I")
  1.  I TIMECLINICOPENS="" S TIMECLINICOPENS=8
  1.  ;
  1.  I +$E($P(TARGETDATE,".",2)_"0000",1,4)<TIMECLINICOPENS D ERRLOG^SDES2JSON(.ERRORS,344)
  1.  I '$G(^SC(TARGETCLINIC,"ST",$P(TARGETDATE,"."),0)) D ERRLOG^SDES2JSON(.ERRORS,466)
  1.  Q
  1.  ;
  1. VALIDATELENGTHS(ERRORS,RESOURCEIEN,TARGETCLINIC,APPTIEN) ;
  1.  I $$GET1^DIQ(44,TARGETCLINIC,1912)'=$$GET1^DIQ(44,$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I"),1912) D ERRLOG^SDES2JSON(.ERRORS,500)
  1.  I $$GET1^DIQ(409.84,APPTIEN,.18,"I")'=$$GET1^DIQ(44,$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I"),1912) D ERRLOG^SDES2JSON(.ERRORS,507)
  1.  Q
  1.  ;
  1. PRIVILEGEDUSER(ERRORS,TARGETCLINIC,SDDUZ) ;
  1.  I $$GET1^DIQ(44,TARGETCLINIC,2500,"I")="Y" D
  1.  .I '$D(^SC(TARGETCLINIC,"SDPRIV",SDDUZ,0)) D ERRLOG^SDES2JSON(.ERRORS,343)
  1.  Q
  1.  ;
  1. VALIDATEDATE(ERRORS,DATE,CLINICIEN) ;
  1.  I DATE="" D ERRLOG^SDES2JSON(.ERRORS,9) Q
  1.  S DATE=$$ISOTFM^SDAMUTDT(DATE)
  1.  I DATE=-1 D ERRLOG^SDES2JSON(.ERRORS,11) Q
  1.  I '$P(DATE,".",2) D ERRLOG^SDES2JSON(.ERRORS,511) Q
  1.  ; cant schedule on holiday if clinic does not allow
  1.  I $$GET1^DIQ(44,CLINICIEN,1918.5,"I")'="Y",$D(^HOLIDAY($P(DATE,"."),0)) D ERRLOG^SDES2JSON(.ERRORS,465)
  1.  Q
  1.  ;
  1. BUILDAPPTARRAY(APPOINTMENT,PARAMS) ;
  1.  N ORIGINALAPPT,TARGETDATE,TARGETCLINIC,APPTIEN,FMDATETIME
  1.  S APPTIEN=PARAMS("APPT IEN")
  1.  S TARGETDATE=PARAMS("TARGET DATE TIME")
  1.  S FMDATETIME=$$ISOTFM^SDAMUTDT(TARGETDATE)
  1.  S TARGETCLINIC=PARAMS("TARGET CLINIC IEN")
  1.  D GETS^DIQ(409.84,APPTIEN,"*","ZI","ORIGINALAPPT")
  1.  ;
  1.  S APPOINTMENT("START DATE TIME")=TARGETDATE
  1.  S APPOINTMENT("END DATE TIME")=$$FMTISO^SDAMUTDT($$FMADD^XLFDT(FMDATETIME,,,$$GET1^DIQ(409.84,APPTIEN,.18,"I")))
  1.  S APPOINTMENT("DFN")=$G(ORIGINALAPPT(409.84,APPTIEN_",",.05,"I"))
  1.  S APPOINTMENT("RESOURCE IEN")=$$GETRES^SDESINPUTVALUTL(TARGETCLINIC,1)
  1.  S APPOINTMENT("WALKIN")="N"
  1.  S APPOINTMENT("PATIENT INDICATED DATE")=$$FMTISO^SDAMUTDT($G(ORIGINALAPPT(409.84,APPTIEN_",",.2,"I")))
  1.  S APPOINTMENT("EXTERNAL ID")=""
  1.  S APPOINTMENT("REQUEST TYPE")=$E($$GET1^DIQ(409.84,APPTIEN,.22,"E"),1,1)_"|"_$P($G(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";",1)
  1.  S APPOINTMENT("PROVIDER IEN")=$G(ORIGINALAPPT(409.84,APPTIEN_",",.16,"I"))
  1.  S APPOINTMENT("CLINIC IEN")=TARGETCLINIC
  1.  S APPOINTMENT("NOTE")=$G(ORIGINALAPPT(409.84,APPTIEN_",",.1,"I"))
  1.  S APPOINTMENT("APPOINTMENT TYPE")=""
  1.  S APPOINTMENT("APPOINTMENT TYPE NAME")=$$GET1^DIQ(409.1,$G(ORIGINALAPPT(409.84,APPTIEN_",",.06,"I")),.01,"E")
  1.  S APPOINTMENT("PATIENT STATUS")=$G(ORIGINALAPPT(409.84,APPTIEN_",",.23,"I"))
  1.  S APPOINTMENT("APPOINTMENT LENGTH")=$G(ORIGINALAPPT(409.84,APPTIEN_",",.18,"I"))
  1.  S APPOINTMENT("SERVICE CONNECTED")=""
  1.  S APPOINTMENT("SERVICE CONNECTED PERCENTAGE")=""
  1.  I $$GET1^DIQ(409.85,$P($G(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8) D
  1.   . S APPOINTMENT("MRTC")="TRUE"
  1.   . S APPOINTMENT("MRTC PARENT")=$$GET1^DIQ(409.85,$P($G(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8)
  1.  S APPOINTMENT("APPOINTMENT REASON")="TEST"
  1.  S APPOINTMENT("PATIENT ELIGIBILITY")=2
  1.  S APPOINTMENT("OVERBOOK")=""
  1.  S APPOINTMENT("LAB DATE TIME")=""
  1.  S APPOINTMENT("XRAY DATE TIME")=""
  1.  S APPOINTMENT("EKG DATE TIME")=""
  1.  S APPOINTMENT("PURPOSE")=3
  1.  S APPOINTMENT("COLLATERAL")=""
  1.  S APPOINTMENT("SCHEDULE REQUEST TYPE")="P"
  1.  S APPOINTMENT("NEXT AVAILABLE APPOINTMENT")=0
  1.  S APPOINTMENT("FOLLOWUP")="" Q
  1.  ;