SDES2BLOCKMOVE.m

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 ---SDES2BLOCKMOVE   9507     printed  Dec 13, 2024@02:53:22                                                                                                                                                                                              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      ;