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