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

SDESBLKANDMOVE.m

Go to the documentation of this file. 
  1. SDESBLKANDMOVE ;ALB/TAW,MGD,LAB - BLOCK AND MOVE ;May 09,2023
  1.  ;;5.3;Scheduling;**797,799,800,801,803,804,805,807,819,820,843**;Aug 13, 1993;Build 9
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  ; Reference to ^HOLIDAY is supported by IA #10038
  1.  ; Reference to ^VA(200 is supported by IA #10060
  1.  ;
  1. APPTBLOCKMOVE(RETURN,APPTIEN,TORES,TODTNET,EASTRCKNGNMBR) ;
  1.  N POP,SDAPPT,TODTFM,FROMRES,APPTARY,FN,SDECAPPTIENS,NEWAPPTIEN,TODTFMEND,TOTIMESCALE,SDTOCLIEN,CLINBEG,SDDUZ
  1.  N FROMDTFM,FROMDTNET,TIMESCALEDIFF,SDSLOT2BLK,FROMTIMESCALE,SDORGCLIEN,TOENDDTFM
  1.  N ENDDTFM,SDSEGMENTS,APPTLENGTH,SDPID,SDDATA44SLFROM,SDDATA44SLTO,CLINBEGFROM,CLINBEGTO,OVB
  1.  S (POP,NEWAPPTIEN,TIMESCALEDIFF)=0,TODTFMEND=""
  1.  D VALIDATEINPUT
  1.  I 'POP D LOADAPPTDATA(.FN,.APPTARY,.SDECAPPTIENS)
  1.  I 'POP D SLOTCOUNT
  1.  I 'POP D VALIDATE
  1.  I 'POP D COMPARETIMESCALE
  1.  I 'POP D CHKAVAILABILITY^SDESBLKANDMOVE1(TORES,SDTOCLIEN,TODTNET,"T",TODTFM)
  1.  I 'POP D CHKAVAILABILITY^SDESBLKANDMOVE1(FROMRES,SDORGCLIEN,FROMDTNET,"F",FROMDTFM)
  1.  I 'POP D TOOVBCHECK^SDESBLKANDMOVE1(SDTOCLIEN,TODTFM,.APPTARY,FN,SDECAPPTIENS,.POP,.SDAPPT,.OVB)
  1.  I 'POP D APPDEL
  1.  I 'POP D
  1.  .I APPTLENGTH<TOTIMESCALE D APPADD(APPTIEN,TODTFM,TOTIMESCALE,TORES,TOENDDTFM,FN,.APPTARY,SDECAPPTIENS) Q
  1.  .I APPTLENGTH>=TOTIMESCALE D APPADD(APPTIEN,TODTFM,APPTLENGTH,TORES,TOENDDTFM,FN,.APPTARY,SDECAPPTIENS)
  1.  I 'POP D PREBLOCK^SDESBLKANDMOVE1(FROMDTFM,FROMTIMESCALE,FROMRES,SDORGCLIEN,SDDATA44SLFROM,.SDSEGMENTS)
  1.  I 'POP D
  1.  .I NEWAPPTIEN S SDAPPT("BlockAndMove","NewAppointmentIEN")=NEWAPPTIEN
  1.  .E  D ERRLOG^SDESJSON(.SDAPPT)  ;This should not happen but..force unknown error
  1.  K ^TMP("SDEC57",$J)
  1.  D BUILDER^SDESBLKANDMOVE1
  1.  Q
  1.  ;
  1. VALIDATEINPUT ;Validate input parameters from the APPTBLOCKMOVE entry point
  1.  S APPTIEN=$G(APPTIEN)
  1.  I APPTIEN="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,3)
  1.  I APPTIEN'="",'$D(^SDEC(409.84,APPTIEN,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,4)
  1.  ;
  1.  S TORES=$G(TORES)
  1.  I TORES="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,69)
  1.  I TORES'="",'$D(^SDEC(409.831,TORES,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,70)
  1.  ;
  1.  S TODTNET=$G(TODTNET)
  1.  I TODTNET="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,76)
  1.  I TODTNET'="" D
  1.  .S TODTFM=$$NETTOFM^SDECDATE(TODTNET)
  1.  .I TODTFM=-1 S POP=1 D ERRLOG^SDESJSON(.SDAPPT,77) Q
  1.  .I $P(TODTFM,".")<DT S POP=1 D ERRLOG^SDESJSON(.SDAPPT,71)
  1.  ;validate EAS Tracking Number
  1.  S EASTRCKNGNMBR=$TR($G(EASTRCKNGNMBR),"^"," ")
  1.  I $L(EASTRCKNGNMBR) S EASTRCKNGNMBR=$$EASVALIDATE^SDESUTIL(EASTRCKNGNMBR)
  1.  I EASTRCKNGNMBR=-1 S POP=1 D ERRLOG^SDESJSON(.SDAPPT,142)
  1.  ; validate DUZ
  1.  S SDDUZ=$G(SDDUZ,DUZ)
  1.  I SDDUZ="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Missing DUZ")
  1.  I SDDUZ,'$$FIND1^DIC(200,,"A",DUZ,"","","SDERR") S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Invalid DUZ")
  1.  Q
  1.  ;
  1. LOADAPPTDATA(FN,APPTARY,SDECAPPTIENS) ;Load variables used throughout B&M
  1.  N SDMSG
  1.  S FN=409.84,SDECAPPTIENS=APPTIEN_","
  1.  D GETS^DIQ(FN,SDECAPPTIENS,"**","IE","APPTARY","SDMSG") ;Data from SDEC APPOINTMENT file 409.84 for a record
  1.  S FROMDTFM=$G(APPTARY(FN,SDECAPPTIENS,.01,"I"))
  1.  S FROMDTNET=$$FMTONET^SDECDATE(FROMDTFM)
  1.  S ENDDTFM=$G(APPTARY(FN,SDECAPPTIENS,.02,"I"))
  1.  S FROMRES=$G(APPTARY(FN,SDECAPPTIENS,.07,"I"))   ;Originating Resource IEN
  1.  S SDORGCLIEN=$$GET1^DIQ(409.831,FROMRES,.04,"I") ;Originating Clinic IEN
  1.  S SDTOCLIEN=$$GET1^DIQ(409.831,TORES,.04,"I")    ;Destination Clinic IEN
  1.  S SDPID=$G(APPTARY(FN,SDECAPPTIENS,.2,"E"))
  1.  ; Load Resource & Clinic info
  1.  S SDDATA44SLFROM=$G(^SC(SDORGCLIEN,"SL"))
  1.  S CLINBEGFROM=$P(SDDATA44SLFROM,U,3)
  1.  I CLINBEGFROM="" S CLINBEGFROM=8
  1.  S CLINBEGFROM=$$PADCLTIME^SDESUTIL(CLINBEGFROM)
  1.  S SDDATA44SLTO=$G(^SC(SDTOCLIEN,"SL"))
  1.  S CLINBEGTO=$P(SDDATA44SLTO,U,3)
  1.  I CLINBEGTO="" S CLINBEGTO=8
  1.  S CLINBEGTO=$$PADCLTIME^SDESUTIL(CLINBEGTO)
  1.  S FROMTIMESCALE=$P(^SDEC(409.831,FROMRES,0),"^",3)
  1.  S TOTIMESCALE=$P(^SDEC(409.831,TORES,0),"^",3)
  1.  I FROMTIMESCALE="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,73,"Time span")
  1.  I TOTIMESCALE="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,73,"Time span")
  1.  I 'POP S TOENDDTFM=$$FMADD^XLFDT(TODTFM,0,0,TOTIMESCALE,0) ;Appt end time at the Destination clinic
  1.  D:'POP SDSEGMENTS
  1.  Q
  1.  ;
  1. VALIDATE ; Simple validation
  1.  N FROMDTFMPAD,TODTFMPAD,ENDDTFMPAD,SDDOW,HASPATRN
  1.  ; From Appt must have same Dt Time as new appt.
  1.  S FROMDTFMPAD=$$PADFMTIME^SDESUTIL($P(FROMDTFM,".",2))
  1.  S TODTFMPAD=$$PADFMTIME^SDESUTIL($P(TODTFM,".",2))
  1.  S ENDDTFMPAD=$$PADFMTIME^SDESUTIL($P(ENDDTFM,".",2))
  1.  ;I $P(FROMDTFM,".")'=$P(TODTFM,".") S POP=1 D ERRLOG^SDESJSON(.SDAPPT,52,"Appointment dates must match")
  1.  I 'POP,+FROMDTFMPAD'=+TODTFMPAD S POP=1 D ERRLOG^SDESJSON(.SDAPPT,52,"Appointment times must match")
  1.  ;
  1.  ; Verify Start/End time of appt is on a single day
  1.  I +ENDDTFMPAD<+FROMDTFMPAD S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Appointment must start & end on a single day") Q
  1.  ;Current Appt must be in a 'scheduled' status only. Can not be checked in, cancelled, etc.
  1.  N APPTSTAT
  1.  S APPTSTAT=$$APPTSTS^SDEC50(APPTIEN,"","")
  1.  I APPTSTAT["CANCELLED"!(APPTSTAT["NO-SHOW")!(APPTSTAT["CHECKED IN")!(APPTSTAT["CHECKED OUT") S POP=1 D ERRLOG^SDESJSON(.SDAPPT,78)
  1.  ; Check for restricted From or To clinic
  1.  I '$$PRIVUSR^SDESCLINICUTIL(SDORGCLIEN,DUZ) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Privileged Originating clinic")
  1.  I '$$PRIVUSR^SDESCLINICUTIL(SDTOCLIEN,DUZ) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Privileged Destination clinic")
  1.  ; Don't allow B&M to prior to the start of the clinic availability
  1.  I +$E($P(TODTFM,".",2)_"0000",1,4)<CLINBEGTO S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Prior to start of Destination clinic")
  1.  ;Check if able to schedule on holiday
  1.  I $$GET1^DIQ(44,SDTOCLIEN_",",1918.5,"I")'="Y",$$FIND1^DIC(40.5,,"B",$P(TODTFM,".",1),"","","SDERR") S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Scheduling on holidays is not permitted")
  1.  S SDDOW=$$DOW^XLFDT($P(TODTFM,".",1),1)
  1.  ; Does Destination clinic have an availability pattern defined for this date
  1.  ;S HASPATRN=$$HASPATRN^SDESBLKANDMOVE1(SDTOCLIEN,SDDOW,$P(TODTFM,".",1))
  1.  ;I HASPATRN=0 S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Destination clinic is not open on this date")
  1.  Q
  1.  ;
  1. COMPARETIMESCALE ;Compare the Time Scale of the Clinic Resource from the original appt vs new appt
  1.  ;The Time Scale of the original appointment can not be greater than the new appointment
  1.  ;  Can't squeeze a 30 min appt into a 10 min slot.
  1.  I 'POP,FROMTIMESCALE>TOTIMESCALE S POP=1 D ERRLOG^SDESJSON(.SDAPPT,74) Q
  1.  ; Check for clinics being multiples
  1.  I TOTIMESCALE#FROMTIMESCALE'=0  S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Destination clinic not a multiple of Originating clinic")
  1.  Q
  1.  ;
  1. SDSEGMENTS ; Build local array of slots with SCHEDULE and EVALUATE nodes
  1.  N FRSTTMFMADJ,TOENDTMFMADJ,SDSEGSTTIM,SDSEGENDTIM,PADFROMDTFM,PADENDDTFM,CLINID
  1.  ;
  1.  ; Adjust new appt end time when moving a 60 min appt into a 30 min appt slot
  1.  S APPTLENGTH=$$FMDIFF^XLFDT(ENDDTFM,FROMDTFM,2)/60  ;actual length current appt in min
  1.  I APPTLENGTH'>0 S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Invalid appointment length calculation") Q
  1.  I APPTLENGTH>TOTIMESCALE S TOENDDTFM=$$FMADD^XLFDT(TODTFM,0,0,APPTLENGTH,0)  ;Appt end time at the Destination clinic
  1.  I TOENDDTFM=-1!($P(TODTFM,".",1)'=$P(TOENDDTFM,".",1)) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"New appointment crosses midnight") Q
  1.  ;
  1.  ; Init vars for the Destination clinic & appointment
  1.  S PADFROMDTFM=$$PADFMTIME^SDESUTIL($P(TODTFM,".",2))
  1.  S PADENDDTFM=$$PADFMTIME^SDESUTIL($P(TOENDDTFM,".",2))
  1.  S FRSTTMFMADJ=$P($$FMADD^XLFDT(TODTFM,0,0,1,0),".",2)
  1.  S FRSTTMFMADJ=$$PADFMTIME^SDESUTIL(FRSTTMFMADJ)
  1.  S TOENDTMFMADJ=$P($$FMADD^XLFDT(TOENDDTFM,0,0,1,0),".",2)
  1.  S TOENDTMFMADJ=$$PADFMTIME^SDESUTIL(TOENDTMFMADJ)
  1.  S CLINID="T" ; To Clinic
  1.  ; Load To clinic segments from T node of the Hospital Location file
  1.  D SEGARRAY(SDTOCLIEN,TOTIMESCALE,TODTFM,CLINBEGTO,CLINID)
  1.  Q:POP
  1.  ; Determine the evaluation start time
  1.  S SDSEGSTTIM=$O(SDSEGMENTS(SDTOCLIEN,CLINID,"SCHEDULE",+FRSTTMFMADJ),-1)
  1.  ; Would we ever have an appt prior to the defined clinic start time???
  1.  I SDSEGSTTIM="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Prior to start of destination clinic") Q
  1.  ; Appt start time = segment start time
  1.  I +PADFROMDTFM=SDSEGSTTIM  S SDSEGMENTS(SDTOCLIEN,CLINID,"EVALUATE")=SDSEGSTTIM
  1.  ; Appt starts within the segment. Segment 8-8:30 Appt starts at 8:15
  1.  I +PADFROMDTFM>SDSEGSTTIM,(+PADFROMDTFM<SDSEGMENTS(SDTOCLIEN,CLINID,"SCHEDULE",SDSEGSTTIM)) S SDSEGMENTS(SDTOCLIEN,CLINID,"EVALUATE")=SDSEGSTTIM
  1.  ; Appt starts after the segment ends
  1.  I +PADFROMDTFM>=+SDSEGMENTS(SDTOCLIEN,CLINID,"SCHEDULE",SDSEGSTTIM) S SDSEGMENTS(SDTOCLIEN,CLINID,"EVALUATE")=+PADFROMDTFM
  1.  ; Determine the evaluation end time
  1.  S SDSEGENDTIM=$O(SDSEGMENTS(SDTOCLIEN,CLINID,"SCHEDULE",+TOENDTMFMADJ),-1)
  1.  I SDSEGENDTIM="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Can't find slot end time in Originating clinic for evaluation") Q
  1.  ; Appt end time fall within the segment
  1.  I +PADENDDTFM>SDSEGENDTIM,+PADENDDTFM<=+SDSEGMENTS(SDTOCLIEN,CLINID,"SCHEDULE",SDSEGENDTIM) S $P(SDSEGMENTS(SDTOCLIEN,CLINID,"EVALUATE"),U,2)=+SDSEGMENTS(SDTOCLIEN,CLINID,"SCHEDULE",SDSEGENDTIM)
  1.  ; Appt end time > Segment end time
  1.  I +PADENDDTFM>=+SDSEGMENTS(SDTOCLIEN,CLINID,"SCHEDULE",SDSEGENDTIM) S $P(SDSEGMENTS(SDTOCLIEN,CLINID,"EVALUATE"),U,2)=+PADENDDTFM
  1.  ; Appt end time = Segment end time
  1.  I +PADENDDTFM=SDSEGENDTIM S $P(SDSEGMENTS(SDTOCLIEN,CLINID,"EVALUATE"),U,2)=+PADENDDTFM
  1.  ;
  1.  ; If additional time needs to be blocked at the originating clinic to account for moving from a 30 min clinic
  1.  ; to a 60 min clinic.
  1.  I FROMTIMESCALE<TOTIMESCALE D
  1.  .I TODTFM<FROMDTFM S FROMDTFM=TODTFM
  1.  .I TOENDDTFM>ENDDTFM S ENDDTFM=TOENDDTFM
  1.  ;
  1.  ; Init variables for the Originating clinic and appointment
  1.  S PADFROMDTFM=$$PADFMTIME^SDESUTIL($P(FROMDTFM,".",2))
  1.  S FRSTTMFMADJ=$P($$FMADD^XLFDT(FROMDTFM,0,0,1,0),".",2) ;increment by 1 min
  1.  S FRSTTMFMADJ=$$PADFMTIME^SDESUTIL(FRSTTMFMADJ)
  1.  S PADENDDTFM=$$PADFMTIME^SDESUTIL($P(ENDDTFM,".",2))
  1.  S TOENDTMFMADJ=$P($$FMADD^XLFDT(ENDDTFM,0,0,1,0),".",2) ;increment by 1 min
  1.  S TOENDTMFMADJ=$$PADFMTIME^SDESUTIL(TOENDTMFMADJ)
  1.  S CLINID="F" ; From Clinic
  1.  ; Load From clinic segments from T node of the Hospital Location file
  1.  D SEGARRAY(SDORGCLIEN,FROMTIMESCALE,FROMDTFM,CLINBEGFROM,CLINID)
  1.  Q:POP
  1.  ; Determine the evaluation start time
  1.  S SDSEGSTTIM=$O(SDSEGMENTS(SDORGCLIEN,CLINID,"SCHEDULE",+FRSTTMFMADJ),-1)
  1.  ; Would we ever have an appt prior to the defined clinic start time???
  1.  I SDSEGSTTIM="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Can't find slot begin time in originating clinic for evaluation") Q
  1.  ; Appt start time = segment start time
  1.  I +PADFROMDTFM=SDSEGSTTIM  S SDSEGMENTS(SDORGCLIEN,CLINID,"EVALUATE")=SDSEGSTTIM
  1.  ; Appt starts within the segment. Segment 8-8:30 Appt starts at 8:15
  1.  I +PADFROMDTFM>SDSEGSTTIM,(+PADFROMDTFM<SDSEGMENTS(SDORGCLIEN,CLINID,"SCHEDULE",SDSEGSTTIM)) S SDSEGMENTS(SDORGCLIEN,CLINID,"EVALUATE")=SDSEGSTTIM
  1.  ; Appt starts after the segment ends
  1.  I +PADFROMDTFM>=+SDSEGMENTS(SDORGCLIEN,CLINID,"SCHEDULE",SDSEGSTTIM) S SDSEGMENTS(SDORGCLIEN,CLINID,"EVALUATE")=+PADFROMDTFM
  1.  ; Determine the evaluation end time
  1.  S SDSEGENDTIM=$O(SDSEGMENTS(SDORGCLIEN,CLINID,"SCHEDULE",+TOENDTMFMADJ),-1)
  1.  I SDSEGENDTIM="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Can't find slot end time in originating clinic for evaluation") Q
  1.  ; Appt end time fall within the segment
  1.  I +PADENDDTFM>SDSEGENDTIM,+PADENDDTFM<=+SDSEGMENTS(SDORGCLIEN,CLINID,"SCHEDULE",SDSEGENDTIM) S $P(SDSEGMENTS(SDORGCLIEN,CLINID,"EVALUATE"),U,2)=+SDSEGMENTS(SDORGCLIEN,CLINID,"SCHEDULE",SDSEGENDTIM)
  1.  ; Appt end time > Segment end time
  1.  I +PADENDDTFM>=+SDSEGMENTS(SDORGCLIEN,CLINID,"SCHEDULE",SDSEGENDTIM) S $P(SDSEGMENTS(SDORGCLIEN,CLINID,"EVALUATE"),U,2)=+PADENDDTFM
  1.  ; Appt end time = Segment end time
  1.  I +PADENDDTFM=SDSEGENDTIM S $P(SDSEGMENTS(SDORGCLIEN,CLINID,"EVALUATE"),U,2)=+PADENDDTFM
  1.  Q
  1.  ;
  1. SEGARRAY(CLIEN,TIMESCALE,FROMDTFM,CLINBEG,CLINID) ; Create local array to hold segments for validation comparisons
  1.  N PATRNIEN,SDDOW,SDINDX,SDENDTIME,SDSLDATA,STOP,TINDX,I
  1.  S PATRNIEN=$P(FROMDTFM,".",1)
  1.  I '$D(^SC(CLIEN,"T",PATRNIEN,0)) D  Q:PATRNIEN'>0
  1.  .S SDDOW=$$DOW^XLFDT(PATRNIEN,1)
  1.  .F  S PATRNIEN=$O(^SC(CLIEN,"T",PATRNIEN),-1) Q:PATRNIEN=0  Q:$$DOW^XLFDT(PATRNIEN,1)=SDDOW
  1.  .I PATRNIEN'>0 S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"Availability definition not found")
  1.  ; Loop to find start time definition
  1.  S SDINDX=0
  1.  F  S SDINDX=$O(^SC(CLIEN,"T",PATRNIEN,2,SDINDX)) Q:'SDINDX  D
  1.  .S SDSLDATA=^SC(CLIEN,"T",PATRNIEN,2,SDINDX,0)
  1.  .S SDENDTIME=$$FMADD^XLFDT(DT_"."_$P(SDSLDATA,U,1),,,TIMESCALE)
  1.  .S SDSEGMENTS(CLIEN,CLINID,"SCHEDULE",+$P(SDSLDATA,U,1))=+$$PADFMTIME^SDESUTIL($P(SDENDTIME,".",2))_"^"_$P(SDSLDATA,U,2)
  1.  ; Check and build Teal area
  1.  S SDINDX=0
  1.  S SDINDX=$O(SDSEGMENTS(CLIEN,CLINID,"SCHEDULE",SDINDX))
  1.  Q:SDINDX=CLINBEG
  1.  S STOP=""
  1.  F I=1:1 D  Q:STOP
  1.  .S TINDX=$$FMADD^XLFDT(DT_"."_$$PADLENGTH^SDESUTIL(SDINDX,"0",4,"F"),,,-TIMESCALE)
  1.  .I $P(TINDX,".",1)'=DT S STOP=1 Q
  1.  .I $P(TINDX,".",2)=24 D  Q
  1.  ..S STOP=1,SDSEGMENTS(CLIEN,CLINID,"SCHEDULE",0)=SDINDX_"^-"
  1.  .S TINDX=+$$PADFMTIME^SDESUTIL($P(TINDX,".",2))
  1.  .I +TINDX<=CLINBEG S STOP=1,TINDX=CLINBEG
  1.  .S SDSEGMENTS(CLIEN,CLINID,"SCHEDULE",+TINDX)=SDINDX_"^-"
  1.  .S SDINDX=+TINDX
  1.  Q
  1.  ;
  1. SLOTCOUNT ;
  1.  ; Verifying that we don't have more than the max allowable slots defined for the period of time we are reviewing
  1.  I $$IDTIMESLOT^SDESBLKANDMOVE1(SDORGCLIEN,1,"F") S POP=1 D ERRLOG^SDESJSON(.SDAPPT,124,"More than 1 appointment slot in Originating clinic") Q:POP
  1.  Q
  1.  ;
  1. APPDEL ;Call APPDEL RPC to cancel the current appointment
  1.  ;Input:
  1.  ; SDECAPPTIEN [REQ] - IEN of appointment to cancel
  1.  ;Assume:
  1.  ; SDAPPT - Array of data returned by the RPC
  1.  ;Output:
  1.  ; Any errors logged by call to APPDEL RPC
  1.  N RET,TEXT,SDCANRSN,SDUSRNOTE,SDCANDT,SDAPTYP,SDF
  1.  S SDCANRSN=$$FIND1^DIC(409.2,,"B","BLOCK AND MOVE","","","SDERR")
  1.  I 'SDCANRSN S SDCANRSN=""
  1.  S SDF=""
  1.  S SDAPTYP=$G(APPTARY(FN,SDECAPPTIENS,.22,"I"))
  1.  ;I $P(SDAPTYP,";",2)="SD(403.5," S SDF=3
  1.  D APPDEL^SDEC08(.RET,APPTIEN,"C",SDCANRSN,,,,,SDF,,,$G(EASTRCKNGNMBR))
  1.  S TEXT=$G(^TMP("SDEC08",$J,"APPDEL",1))
  1.  S TEXT=$P(TEXT,$C(30))
  1.  I TEXT'="" D
  1.  .S POP=1 D ERRLOG^SDESJSON(.SDAPPT,52,TEXT,"APPDEL^SDESAPPTSET")
  1.  K ^TMP("SDEC08",$J)
  1.  Q
  1.  ;
  1. APPADD(SDECAPPTIEN,SDECSTART,SDECLEN,SDECRES,SDECEND,FN,APPTARY,SDECAPPTIENS) ;entry point before calling APPADD^SDEC07
  1.  ;Input:
  1.  ; SDECAPPTIEN [REQ] - The IEN from SDEC APPOINTMENT File #409.84
  1.  ; SDECSTART   [REQ] - The internal format of Appointment Start Time
  1.  ; SDECLEN     [REQ] - Appointment length based on Time Scale from 409.831
  1.  ; SDECRES     [REQ] - The IEN from SDEC RESOURCE File #409.831.
  1.  ; SDECEND     [REQ] - Appointment end dt/tm in FM format
  1.  ;
  1.  ;Assume:
  1.  ; APPTARY - Array of data from 409.84 for SDECAPPTIEN
  1.  ; SDAPPT  - Array of data returned by the RPC
  1.  ;
  1.  ;Output:
  1.  ; Errors logged by call to APPADD or set NEWAPPTIEN
  1.  ;
  1.  N SDRET,SDDFN,SDECNOTE,SDECATID,SDECCR,SDDDT,SDAPTYP,SDCL,SDEL,SDECY
  1.  K ^TMP("SDEC07",$J)
  1.  S SDDFN=$G(APPTARY(FN,SDECAPPTIENS,.05,"I")) ;Patient ID/DFN
  1.  S SDCL=$P($G(^SDEC(409.831,+SDECRES,0)),U,4) ;Clinic IEN pointer to HOSPITAL LOCATION file 44
  1.  ;S SDECEND=$$FMADD^XLFDT(SDECSTART,,,+SDECLEN) ;Appointment end time if SDECEND passed in as NULL
  1.  S SDECNOTE=$G(APPTARY(FN,SDECAPPTIENS,1,1)) ;Note
  1.  S SDECATID=$G(APPTARY(FN,SDECAPPTIENS,.13,"E")) ;WALKIN - WALKIN flag y=YES; n=NO default to NO
  1.  I SDECATID=""!(SDECATID="NO") S SDECATID=$P($G(^DPT(SDDFN,"S",SDECSTART,0)),U,7) ;get the purpose of visit in the patient file if NULL in file 409.84
  1.  S SDECATID=$S(SDECATID="YES"!(SDECATID=4):"WALKIN",1:SDECATID)
  1.  S SDECCR=$S(SDECATID="WALKIN":0,1:1) ;routing slip
  1.  S SDDDT=$G(APPTARY(FN,SDECAPPTIENS,.02,"I")) ;desired date of appointment
  1.  S SDAPTYP=$$GET1^DIQ(FN,SDECAPPTIENS,.22,"E")
  1.  S SDAPTYP=$S(SDAPTYP="APPT":"A",SDAPTYP="RECALL":"R",SDAPTYP="CONSULT":"C",SDAPTYP="EWL":"E",1:"")
  1.  S SDAPTYP=SDAPTYP_"|"_$P($$GET1^DIQ(FN,SDECAPPTIENS,.22,"I"),";")
  1.  S SDEL=$P($G(^DPT(SDDFN,.36)),U,1) ;Current Eligibility Code
  1.  K SDECY
  1.  D APPADD^SDEC07(.SDECY,$$FMTE^XLFDT(SDECSTART),$$FMTE^XLFDT(SDECEND),SDDFN,SDECRES,SDECLEN,$G(SDECNOTE),SDECATID,,,SDPID,,,,,SDAPTYP,,,SDCL,,,,,OVB,,SDEL,$G(EASTRCKNGNMBR)) ;ADD NEW APPOINTMENT
  1.  ;
  1.  N CNTR,ERROR
  1.  S ERROR=""
  1.  S CNTR=$O(^TMP("SDEC07",$J,0))
  1.  I CNTR S ERROR=$G(^TMP("SDEC07",$J,CNTR))
  1.  S ERROR=$$CTRL^XMXUTIL1(ERROR)
  1.  I $P(ERROR,"^",2)'="" D
  1.  .S POP=1
  1.  .D ERRLOG^SDESJSON(.SDAPPT,52,$P(ERROR,"^",2),"APPADD^SDESAPPTSET")
  1.  E  D
  1.  .S NEWAPPTIEN=$P(ERROR,"^",1)
  1.  .I $E(SDAPTYP,1)="R",$G(APPTARY(FN,SDECAPPTIENS,.22,"I"))'="" D
  1.  ..N SDBM
  1.  ..S SDBM(409.84,NEWAPPTIEN_",",.22)=$G(APPTARY(FN,SDECAPPTIENS,.22,"I"))
  1.  ..D UPDATE^DIE("","SDBM","SDERR")
  1.  ;
  1.  K ^TMP("SDEC07",$J)
  1.  Q