SDES2BLOCKANDMOV ;ALB/BLB,TJB,BLB,BWF,MCB - BLOCK AND MOVE ;January 31, 2025
;;5.3;Scheduling;**875,880,889,895,897,898,899**;Aug 13, 1993;Build 2
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
BLOCKANDMOVE(JSON,SDCONTEXT,BLOCKANDMOVE) ;
N BLOCKMOVERETURN,ERRORS,APPOINTMENT,JSONCANCEL,JSONCANCLINAVAIL,ORIGINALCLINIC,JSONAPPOINTMENT,APPTRETURN,CANCELAVAIL,OVERBOOK,TARGETDATE,SLOT,TIMECLINICOPENS,TARGETSLOT,ORIGSLOTS,ORIGINATINGSLOTS,IENS44
;
D POPULATE(.BLOCKANDMOVE,.APPTIEN,.TARGETCLINIC,.TARGETDATE,.ORIGINALCLINIC,.CANCELAVAIL,.SLOT,.TARGETSLOT,.OVERBOOK,.ORIGSLOTS,.ORIGINATINGSLOTS,.TIMECLINICOPENS,.IENS44,.ERRORS)
I $D(ERRORS) D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
D VALIDATE(.ERRORS,.SDCONTEXT,$G(APPTIEN),$G(TARGETCLINIC),$G(CANCELAVAIL("REMARKS")),TARGETDATE,OVERBOOK,.APPOINTMENT,.CANCELAVAIL,ORIGINALCLINIC,.TARGETSLOT,.ORIGINATINGSLOTS,TIMECLINICOPENS,IENS44)
I $D(ERRORS) D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
;
D CANCEL^SDES2CANCLNAVAIL(.JSONCANCLINAVAIL,.SDCONTEXT,.CANCELAVAIL)
;
D BUILDAPPTARRAY(.APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC,IENS44)
D CREATE^SDES2CREATEAPPT(.JSONAPPOINTMENT,.SDCONTEXT,.APPOINTMENT)
D DECODE^XLFJSON("JSONAPPOINTMENT","APPTRETURN")
;
S BLOCKMOVERETURN("BlockAndMoveAppointment","NewAppointmentIEN")=$G(APPTRETURN("Appointment","IEN"))
D BUILDJSON^SDES2JSON(.JSON,.BLOCKMOVERETURN)
Q
;
VALIDATE(ERRORS,SDCONTEXT,APPTIEN,TARGETCLINIC,REMARKS,TARGETDATE,OVERBOOK,APPOINTMENT,CANCELAVAIL,ORIGINALCLINIC,TARGETSLOT,ORIGINATINGSLOTS,TIMECLINICOPENS,IENS44) ;
N VAL,FDA
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
D VALFILEIEN^SDES2VALUTIL(,.ERRORS,44,$G(TARGETCLINIC),1,,18,19)
I $D(ERRORS) Q
;
I $$GET1^DIQ(44,TARGETCLINIC,1918.5,"I")'="Y",$D(^HOLIDAY($P(TARGETDATE,"."),0)) D ERRLOG^SDES2JSON(.ERRORS,465)
I $$GET1^DIQ(44,TARGETCLINIC,2500,"I")="Y",'$D(^SC(TARGETCLINIC,"SDPRIV",$S($G(SDCONTEXT("USER DUZ")):SDCONTEXT("USER DUZ"),1:DUZ),0)) D ERRLOG^SDES2JSON(.ERRORS,343)
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)
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)
;
I '$L($$GET1^DIQ(44.005,$P(TARGETDATE,".")_","_TARGETCLINIC_",",1,"I")) D ERRLOG^SDES2JSON(.ERRORS,466) 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 $D(ERRORS) Q
;
D VALIDATEORIGSLOT(.ERRORS,.ORIGINATINGSLOTS,ORIGINALCLINIC,APPTIEN,$$GET1^DIQ(409.84,APPTIEN,.02,"I"))
D VALAPPTLENGTHS(.ERRORS,ORIGINALCLINIC,TARGETCLINIC,APPTIEN,TARGETDATE,.TARGETSLOT)
I $D(ERRORS) Q
;
D VALIDATE^SDES2CANCLNAVAIL(.ERRORS,.SDCONTEXT,.CANCELAVAIL,ORIGINALCLINIC,"P",REMARKS)
S CANCELAVAIL("START DATE TIME")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),ORIGINALCLINIC)
S CANCELAVAIL("END DATE TIME")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC)
I $D(ERRORS) Q
;
D BUILDAPPTARRAY(.APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC,IENS44)
S FDA(409.85,$P($$GET1^DIQ(409.84,APPTIEN,.22,"I"),";")_",",23)="O" D FILE^DIE(,"FDA") K FDA
D VALIDATE^SDES2CREATEAPPT(.ERRORS,.SDCONTEXT,.APPOINTMENT,.VAL,1)
S FDA(409.85,$P($$GET1^DIQ(409.84,APPTIEN,.22,"I"),";")_",",23)="C" D FILE^DIE(,"FDA") K FDA
Q
;
VALIDATEORIGSLOT(ERRORS,ORIGINATINGSLOTS,CLINICIEN,APPTIEN,ENDTIME) ;
N SLOTS,SLOTNUM,NUMBEROFAPPTS,COUNT,SUBIEN,DATETIME,DONE
;
I '$D(ORIGINATINGSLOTS("ClinAvail",1,"SlotsAvail")) D ERRLOG^SDES2JSON(.ERRORS,52,"No availability defined for the originating clinic at the original appointment time. Cannot block and move.") Q
S SLOTNUM=0,DONE=0
F S SLOTNUM=$O(ORIGINATINGSLOTS("ClinAvail",SLOTNUM)) Q:'SLOTNUM!($D(ERRORS))!(DONE) D
.I $$ISOTFM^SDAMUTDT($G(ORIGINATINGSLOTS("ClinAvail",SLOTNUM,"EndTime")),CLINICIEN)>$$GET1^DIQ(409.84,APPTIEN,.02,"I") S DONE=1 Q
.I $G(ORIGINATINGSLOTS("ClinAvail",SLOTNUM,"SlotsAvail"))'=0 D ERRLOG^SDES2JSON(.ERRORS,468) Q
.S DATETIME=$$ISOTFM^SDAMUTDT($G(ORIGINATINGSLOTS("ClinAvail",SLOTNUM,"BeginTime")),CLINICIEN)
.;
.S COUNT=0,SUBIEN=0
.F S SUBIEN=$O(^SC(CLINICIEN,"S",DATETIME,1,SUBIEN)) Q:'SUBIEN D
..I $$GET1^DIQ(44.003,SUBIEN_","_DATETIME_","_CLINICIEN_",",310)="CANCELLED" Q
..S COUNT=COUNT+1
..I SLOTNUM=1,COUNT=1 Q
..D ERRLOG^SDES2JSON(.ERRORS,468)
Q
;
POPULATE(BLOCKANDMOVE,APPTIEN,TARGETCLINIC,TARGETDATE,ORIGINALCLINIC,CANCELAVAIL,SLOT,TARGETSLOT,OVERBOOK,ORIGSLOTS,ORIGINATINGSLOTS,TIMECLINICOPENS,IENS44,ERRORS) ;
;
S APPTIEN=$G(BLOCKANDMOVE("APPOINTMENT IEN"))
D VALFILEIEN^SDES2VALUTIL(,.ERRORS,409.84,$G(APPTIEN),1,,14,15)
I $D(ERRORS) Q
;
S TARGETCLINIC=$G(BLOCKANDMOVE("TARGET CLINIC"))
S ORIGINALCLINIC=$$GET1^DIQ(409.831,$$GET1^DIQ(409.84,$G(APPTIEN),.07,"I"),.04,"I")
S TARGETDATE=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$G(BLOCKANDMOVE("TARGET DATE TIME")),TARGETCLINIC,1,25,26)
S TIMECLINICOPENS=$S($$GET1^DIQ(44,TARGETCLINIC,1914,"I"):$$GET1^DIQ(44,TARGETCLINIC,1914,"I"),1:8)
S OVERBOOK=""
S IENS44=$$GET44RECORDIENS^SDESCANAPPT2(ORIGINALCLINIC,$$GET1^DIQ(409.84,APPTIEN,.01,"I"),$$GET1^DIQ(409.84,APPTIEN,.05,"I"))
;
D GETCLAVAILABLTY^SDESCLINICAVAIL(.SLOT,TARGETCLINIC,$$FMTISO^SDAMUTDT(TARGETDATE,TARGETCLINIC),$$FMTISO^SDAMUTDT(TARGETDATE,TARGETCLINIC))
D DECODE^XLFJSON("SLOT","TARGETSLOT")
I '$G(TARGETSLOT("ClinAvail",1,"SlotsAvail")),"abcdefghijklmnopqrstuvwxyz"'[$G(TARGETSLOT("ClinAvail",1,"SlotsAvail")) S OVERBOOK="O"
;
D GETCLAVAILABLTY^SDESCLINICAVAIL(.ORIGSLOTS,ORIGINALCLINIC,$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),ORIGINALCLINIC),$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC))
D DECODE^XLFJSON("ORIGSLOTS","ORIGINATINGSLOTS")
;
S CANCELAVAIL("CLINIC IEN")=ORIGINALCLINIC
S CANCELAVAIL("START DATE TIME")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),ORIGINALCLINIC)
S CANCELAVAIL("END DATE TIME")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC)
S CANCELAVAIL("FULL PARTIAL FLAG")="P"
S CANCELAVAIL("REMARKS")="BLOCK AND MOVE"
Q
;
BUILDAPPTARRAY(APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC,IENS44) ;
N ORIGINALAPPT,PATIENS,RESIEN,CLINIEN,DFN,ARRAY298,ARRAY44003,NOTEIDX
;
D GETS^DIQ(409.84,APPTIEN,"*","ZI","ORIGINALAPPT")
S DFN=$G(ORIGINALAPPT(409.84,APPTIEN_",",.05,"I"))
S PATIENS=$G(ORIGINALAPPT(409.84,APPTIEN_",",.01,"I"))_","_DFN_","
D GETS^DIQ(2.98,PATIENS,"**","IE","ARRAY298","ERR")
S RESIEN=$G(ORIGINALAPPT(409.84,APPTIEN_",",.07,"I"))
S CLINIEN=$$GET1^DIQ(409.831,RESIEN_",",.04,"I")
D GETS^DIQ(44.003,IENS44,"**","IE","ARRAY44003","SDMSG")
;
S APPOINTMENT("START DATE TIME")=$$FMTISO^SDAMUTDT(TARGETDATE,TARGETCLINIC)
S APPOINTMENT("END DATE TIME")=$$FMTISO^SDAMUTDT($$FMADD^XLFDT(TARGETDATE,,,$$GET1^DIQ(409.84,APPTIEN,.18,"I")),TARGETCLINIC)
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")=$G(ORIGINALAPPT(409.84,APPTIEN_",",.21,"I"))
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")=$S(TARGETCLINIC=ORIGINALCLINIC:$G(ORIGINALAPPT(409.84,APPTIEN_",",.16,"I")),1:"")
S APPOINTMENT("CLINIC IEN")=TARGETCLINIC
S NOTEIDX=0
S APPOINTMENT("NOTE")=""
F S NOTEIDX=$O(ORIGINALAPPT(409.84,APPTIEN_",",1,NOTEIDX)) Q:+NOTEIDX=0 D
.S APPOINTMENT("NOTE")=APPOINTMENT("NOTE")_ORIGINALAPPT(409.84,APPTIEN_",",1,NOTEIDX,0)
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")="" ;looking do not see why this is being sent, doesn't update in appointment
S APPOINTMENT("SERVICE CONNECTED PERCENTAGE")="" ; doesn't update in appointment
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")=$G(ARRAY44003(44.003,IENS44,3,"I"))
S APPOINTMENT("PATIENT ELIGIBILITY")=$G(ARRAY44003(44.003,IENS44,30,"I"))
S APPOINTMENT("OVERBOOK")=OVERBOOK
S APPOINTMENT("LAB DATE TIME")=$$FMTISO^SDAMUTDT($G(ARRAY298(2.98,PATIENS,5,"I")),CLINIEN)
S APPOINTMENT("XRAY DATE TIME")=$$FMTISO^SDAMUTDT($G(ARRAY298(2.98,PATIENS,6,"I")),CLINIEN)
S APPOINTMENT("EKG DATE TIME")=$$FMTISO^SDAMUTDT($G(ARRAY298(2.98,PATIENS,7,"I")),CLINIEN)
S APPOINTMENT("PURPOSE")=$G(ARRAY298(2.98,PATIENS,9,"E"))
S APPOINTMENT("COLLATERAL")=$G(ARRAY298(2.98,PATIENS,13,"E"))
S APPOINTMENT("SCHEDULE REQUEST TYPE")=$G(ARRAY298(2.98,PATIENS,25,"I"))
S APPOINTMENT("NEXT AVAILABLE APPOINTMENT")=$G(ARRAY298(2.98,PATIENS,26,"I"))
S APPOINTMENT("FOLLOWUP")=$G(ARRAY298(2.98,PATIENS,28,"E"))
Q
VALAPPTLENGTHS(ERRORS,ORIGINALCLINIC,TARGETCLINIC,APPTIEN,TARGETDATETIME,AVAILSLOTS) ;
N ORIGCLINVARLEN,TRGTCLINVARLEN,APPTLENGTH,TRGTCLINAPTLEN,APPTSTART
S ORIGCLINVARLEN=$S($$GET1^DIQ(44,ORIGINALCLINIC,1913,"I")="V":1,1:0)
S TRGTCLINVARLEN=$S($$GET1^DIQ(44,TARGETCLINIC,1913,"I")="V":1,1:0)
S TRGTCLINAPTLEN=$$GET1^DIQ(44,TARGETCLINIC,1912,"I")
S APPTLENGTH=$$GET1^DIQ(409.84,APPTIEN,.18,"I")
I ORIGCLINVARLEN,TRGTCLINVARLEN!('ORIGCLINVARLEN&TRGTCLINVARLEN) D Q
.I APPTLENGTH#TRGTCLINAPTLEN'=0 D ERRLOG^SDES2JSON(.ERRORS,52,"Block and move appointment will not fit in the target clinic's schedule.") Q
I APPTLENGTH'=TRGTCLINAPTLEN D ERRLOG^SDES2JSON(.ERRORS,507)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2BLOCKANDMOV 10187 printed Aug 26, 2025@23:09:31 Page 2
SDES2BLOCKANDMOV ;ALB/BLB,TJB,BLB,BWF,MCB - BLOCK AND MOVE ;January 31, 2025
+1 ;;5.3;Scheduling;**875,880,889,895,897,898,899**;Aug 13, 1993;Build 2
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
BLOCKANDMOVE(JSON,SDCONTEXT,BLOCKANDMOVE) ;
+1 NEW BLOCKMOVERETURN,ERRORS,APPOINTMENT,JSONCANCEL,JSONCANCLINAVAIL,ORIGINALCLINIC,JSONAPPOINTMENT,APPTRETURN,CANCELAVAIL,OVERBOOK,TARGETDATE,SLOT,TIMECLINICOPENS,TARGETSLOT,ORIGSLOTS,ORIGINATINGSLOTS,IENS44
+2 ;
+3 DO POPULATE(.BLOCKANDMOVE,.APPTIEN,.TARGETCLINIC,.TARGETDATE,.ORIGINALCLINIC,.CANCELAVAIL,.SLOT,.TARGETSLOT,.OVERBOOK,.ORIGSLOTS,.ORIGINATINGSLOTS,.TIMECLINICOPENS,.IENS44,.ERRORS)
+4 IF $DATA(ERRORS)
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+5 DO VALIDATE(.ERRORS,.SDCONTEXT,$GET(APPTIEN),$GET(TARGETCLINIC),$GET(CANCELAVAIL("REMARKS")),TARGETDATE,OVERBOOK,.APPOINTMENT,.CANCELAVAIL,ORIGINALCLINIC,.TARGETSLOT,.ORIGINATINGSLOTS,TIMECLINICOPENS,IENS44)
+6 IF $DATA(ERRORS)
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+7 ;
+8 DO CANCEL^SDES2CANCLNAVAIL(.JSONCANCLINAVAIL,.SDCONTEXT,.CANCELAVAIL)
+9 ;
+10 DO BUILDAPPTARRAY(.APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC,IENS44)
+11 DO CREATE^SDES2CREATEAPPT(.JSONAPPOINTMENT,.SDCONTEXT,.APPOINTMENT)
+12 DO DECODE^XLFJSON("JSONAPPOINTMENT","APPTRETURN")
+13 ;
+14 SET BLOCKMOVERETURN("BlockAndMoveAppointment","NewAppointmentIEN")=$GET(APPTRETURN("Appointment","IEN"))
+15 DO BUILDJSON^SDES2JSON(.JSON,.BLOCKMOVERETURN)
+16 QUIT
+17 ;
VALIDATE(ERRORS,SDCONTEXT,APPTIEN,TARGETCLINIC,REMARKS,TARGETDATE,OVERBOOK,APPOINTMENT,CANCELAVAIL,ORIGINALCLINIC,TARGETSLOT,ORIGINATINGSLOTS,TIMECLINICOPENS,IENS44) ;
+1 NEW VAL,FDA
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 DO VALFILEIEN^SDES2VALUTIL(,.ERRORS,44,$GET(TARGETCLINIC),1,,18,19)
+5 IF $DATA(ERRORS)
QUIT
+6 ;
+7 IF $$GET1^DIQ(44,TARGETCLINIC,1918.5,"I")'="Y"
IF $DATA(^HOLIDAY($PIECE(TARGETDATE,"."),0))
DO ERRLOG^SDES2JSON(.ERRORS,465)
+8 IF $$GET1^DIQ(44,TARGETCLINIC,2500,"I")="Y"
IF '$DATA(^SC(TARGETCLINIC,"SDPRIV",$SELECT($GET(SDCONTEXT("USER DUZ")):SDCONTEXT("USER DUZ"),1:DUZ),0))
DO ERRLOG^SDES2JSON(.ERRORS,343)
+9 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)
+10 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)
+11 ;
+12 IF '$LENGTH($$GET1^DIQ(44.005,$PIECE(TARGETDATE,".")_","_TARGETCLINIC_",",1,"I"))
DO ERRLOG^SDES2JSON(.ERRORS,466)
QUIT
+13 IF $PIECE($$GET1^DIQ(409.84,APPTIEN,.01,"I"),".")'=$PIECE($$GET1^DIQ(409.84,APPTIEN,.02,"I"),".")
DO ERRLOG^SDES2JSON(.ERRORS,462)
QUIT
+14 IF $DATA(ERRORS)
QUIT
+15 ;
+16 DO VALIDATEORIGSLOT(.ERRORS,.ORIGINATINGSLOTS,ORIGINALCLINIC,APPTIEN,$$GET1^DIQ(409.84,APPTIEN,.02,"I"))
+17 DO VALAPPTLENGTHS(.ERRORS,ORIGINALCLINIC,TARGETCLINIC,APPTIEN,TARGETDATE,.TARGETSLOT)
+18 IF $DATA(ERRORS)
QUIT
+19 ;
+20 DO VALIDATE^SDES2CANCLNAVAIL(.ERRORS,.SDCONTEXT,.CANCELAVAIL,ORIGINALCLINIC,"P",REMARKS)
+21 SET CANCELAVAIL("START DATE TIME")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),ORIGINALCLINIC)
+22 SET CANCELAVAIL("END DATE TIME")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC)
+23 IF $DATA(ERRORS)
QUIT
+24 ;
+25 DO BUILDAPPTARRAY(.APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC,IENS44)
+26 SET FDA(409.85,$PIECE($$GET1^DIQ(409.84,APPTIEN,.22,"I"),";")_",",23)="O"
DO FILE^DIE(,"FDA")
KILL FDA
+27 DO VALIDATE^SDES2CREATEAPPT(.ERRORS,.SDCONTEXT,.APPOINTMENT,.VAL,1)
+28 SET FDA(409.85,$PIECE($$GET1^DIQ(409.84,APPTIEN,.22,"I"),";")_",",23)="C"
DO FILE^DIE(,"FDA")
KILL FDA
+29 QUIT
+30 ;
VALIDATEORIGSLOT(ERRORS,ORIGINATINGSLOTS,CLINICIEN,APPTIEN,ENDTIME) ;
+1 NEW SLOTS,SLOTNUM,NUMBEROFAPPTS,COUNT,SUBIEN,DATETIME,DONE
+2 ;
+3 IF '$DATA(ORIGINATINGSLOTS("ClinAvail",1,"SlotsAvail"))
DO ERRLOG^SDES2JSON(.ERRORS,52,"No availability defined for the originating clinic at the original appointment time. Cannot block and move.")
QUIT
+4 SET SLOTNUM=0
SET DONE=0
+5 FOR
SET SLOTNUM=$ORDER(ORIGINATINGSLOTS("ClinAvail",SLOTNUM))
if 'SLOTNUM!($DATA(ERRORS))!(DONE)
QUIT
Begin DoDot:1
+6 IF $$ISOTFM^SDAMUTDT($GET(ORIGINATINGSLOTS("ClinAvail",SLOTNUM,"EndTime")),CLINICIEN)>$$GET1^DIQ(409.84,APPTIEN,.02,"I")
SET DONE=1
QUIT
+7 IF $GET(ORIGINATINGSLOTS("ClinAvail",SLOTNUM,"SlotsAvail"))'=0
DO ERRLOG^SDES2JSON(.ERRORS,468)
QUIT
+8 SET DATETIME=$$ISOTFM^SDAMUTDT($GET(ORIGINATINGSLOTS("ClinAvail",SLOTNUM,"BeginTime")),CLINICIEN)
+9 ;
+10 SET COUNT=0
SET SUBIEN=0
+11 FOR
SET SUBIEN=$ORDER(^SC(CLINICIEN,"S",DATETIME,1,SUBIEN))
if 'SUBIEN
QUIT
Begin DoDot:2
+12 IF $$GET1^DIQ(44.003,SUBIEN_","_DATETIME_","_CLINICIEN_",",310)="CANCELLED"
QUIT
+13 SET COUNT=COUNT+1
+14 IF SLOTNUM=1
IF COUNT=1
QUIT
+15 DO ERRLOG^SDES2JSON(.ERRORS,468)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
POPULATE(BLOCKANDMOVE,APPTIEN,TARGETCLINIC,TARGETDATE,ORIGINALCLINIC,CANCELAVAIL,SLOT,TARGETSLOT,OVERBOOK,ORIGSLOTS,ORIGINATINGSLOTS,TIMECLINICOPENS,IENS44,ERRORS) ;
+1 ;
+2 SET APPTIEN=$GET(BLOCKANDMOVE("APPOINTMENT IEN"))
+3 DO VALFILEIEN^SDES2VALUTIL(,.ERRORS,409.84,$GET(APPTIEN),1,,14,15)
+4 IF $DATA(ERRORS)
QUIT
+5 ;
+6 SET TARGETCLINIC=$GET(BLOCKANDMOVE("TARGET CLINIC"))
+7 SET ORIGINALCLINIC=$$GET1^DIQ(409.831,$$GET1^DIQ(409.84,$GET(APPTIEN),.07,"I"),.04,"I")
+8 SET TARGETDATE=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$GET(BLOCKANDMOVE("TARGET DATE TIME")),TARGETCLINIC,1,25,26)
+9 SET TIMECLINICOPENS=$SELECT($$GET1^DIQ(44,TARGETCLINIC,1914,"I"):$$GET1^DIQ(44,TARGETCLINIC,1914,"I"),1:8)
+10 SET OVERBOOK=""
+11 SET IENS44=$$GET44RECORDIENS^SDESCANAPPT2(ORIGINALCLINIC,$$GET1^DIQ(409.84,APPTIEN,.01,"I"),$$GET1^DIQ(409.84,APPTIEN,.05,"I"))
+12 ;
+13 DO GETCLAVAILABLTY^SDESCLINICAVAIL(.SLOT,TARGETCLINIC,$$FMTISO^SDAMUTDT(TARGETDATE,TARGETCLINIC),$$FMTISO^SDAMUTDT(TARGETDATE,TARGETCLINIC))
+14 DO DECODE^XLFJSON("SLOT","TARGETSLOT")
+15 IF '$GET(TARGETSLOT("ClinAvail",1,"SlotsAvail"))
IF "abcdefghijklmnopqrstuvwxyz"'[$GET(TARGETSLOT("ClinAvail",1,"SlotsAvail"))
SET OVERBOOK="O"
+16 ;
+17 DO GETCLAVAILABLTY^SDESCLINICAVAIL(.ORIGSLOTS,ORIGINALCLINIC,$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),ORIGINALCLINIC),$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC))
+18 DO DECODE^XLFJSON("ORIGSLOTS","ORIGINATINGSLOTS")
+19 ;
+20 SET CANCELAVAIL("CLINIC IEN")=ORIGINALCLINIC
+21 SET CANCELAVAIL("START DATE TIME")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),ORIGINALCLINIC)
+22 SET CANCELAVAIL("END DATE TIME")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC)
+23 SET CANCELAVAIL("FULL PARTIAL FLAG")="P"
+24 SET CANCELAVAIL("REMARKS")="BLOCK AND MOVE"
+25 QUIT
+26 ;
BUILDAPPTARRAY(APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC,IENS44) ;
+1 NEW ORIGINALAPPT,PATIENS,RESIEN,CLINIEN,DFN,ARRAY298,ARRAY44003,NOTEIDX
+2 ;
+3 DO GETS^DIQ(409.84,APPTIEN,"*","ZI","ORIGINALAPPT")
+4 SET DFN=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.05,"I"))
+5 SET PATIENS=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.01,"I"))_","_DFN_","
+6 DO GETS^DIQ(2.98,PATIENS,"**","IE","ARRAY298","ERR")
+7 SET RESIEN=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.07,"I"))
+8 SET CLINIEN=$$GET1^DIQ(409.831,RESIEN_",",.04,"I")
+9 DO GETS^DIQ(44.003,IENS44,"**","IE","ARRAY44003","SDMSG")
+10 ;
+11 SET APPOINTMENT("START DATE TIME")=$$FMTISO^SDAMUTDT(TARGETDATE,TARGETCLINIC)
+12 SET APPOINTMENT("END DATE TIME")=$$FMTISO^SDAMUTDT($$FMADD^XLFDT(TARGETDATE,,,$$GET1^DIQ(409.84,APPTIEN,.18,"I")),TARGETCLINIC)
+13 SET APPOINTMENT("DFN")=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.05,"I"))
+14 SET APPOINTMENT("RESOURCE IEN")=$$GETRES^SDESINPUTVALUTL(TARGETCLINIC,1)
+15 SET APPOINTMENT("WALKIN")="N"
+16 SET APPOINTMENT("PATIENT INDICATED DATE")=$$FMTISO^SDAMUTDT($GET(ORIGINALAPPT(409.84,APPTIEN_",",.2,"I")))
+17 SET APPOINTMENT("EXTERNAL ID")=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.21,"I"))
+18 SET APPOINTMENT("REQUEST TYPE")=$EXTRACT($$GET1^DIQ(409.84,APPTIEN,.22,"E"),1,1)_"|"_$PIECE($GET(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";",1)
+19 SET APPOINTMENT("PROVIDER IEN")=$SELECT(TARGETCLINIC=ORIGINALCLINIC:$GET(ORIGINALAPPT(409.84,APPTIEN_",",.16,"I")),1:"")
+20 SET APPOINTMENT("CLINIC IEN")=TARGETCLINIC
+21 SET NOTEIDX=0
+22 SET APPOINTMENT("NOTE")=""
+23 FOR
SET NOTEIDX=$ORDER(ORIGINALAPPT(409.84,APPTIEN_",",1,NOTEIDX))
if +NOTEIDX=0
QUIT
Begin DoDot:1
+24 SET APPOINTMENT("NOTE")=APPOINTMENT("NOTE")_ORIGINALAPPT(409.84,APPTIEN_",",1,NOTEIDX,0)
End DoDot:1
+25 SET APPOINTMENT("APPOINTMENT TYPE")=""
+26 SET APPOINTMENT("APPOINTMENT TYPE NAME")=$$GET1^DIQ(409.1,$GET(ORIGINALAPPT(409.84,APPTIEN_",",.06,"I")),.01,"E")
+27 SET APPOINTMENT("PATIENT STATUS")=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.23,"I"))
+28 SET APPOINTMENT("APPOINTMENT LENGTH")=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.18,"I"))
+29 ;looking do not see why this is being sent, doesn't update in appointment
SET APPOINTMENT("SERVICE CONNECTED")=""
+30 ; doesn't update in appointment
SET APPOINTMENT("SERVICE CONNECTED PERCENTAGE")=""
+31 IF $$GET1^DIQ(409.85,$PIECE($GET(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8)
Begin DoDot:1
+32 SET APPOINTMENT("MRTC")="TRUE"
+33 SET APPOINTMENT("MRTC PARENT")=$$GET1^DIQ(409.85,$PIECE($GET(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8)
End DoDot:1
+34 SET APPOINTMENT("APPOINTMENT REASON")=$GET(ARRAY44003(44.003,IENS44,3,"I"))
+35 SET APPOINTMENT("PATIENT ELIGIBILITY")=$GET(ARRAY44003(44.003,IENS44,30,"I"))
+36 SET APPOINTMENT("OVERBOOK")=OVERBOOK
+37 SET APPOINTMENT("LAB DATE TIME")=$$FMTISO^SDAMUTDT($GET(ARRAY298(2.98,PATIENS,5,"I")),CLINIEN)
+38 SET APPOINTMENT("XRAY DATE TIME")=$$FMTISO^SDAMUTDT($GET(ARRAY298(2.98,PATIENS,6,"I")),CLINIEN)
+39 SET APPOINTMENT("EKG DATE TIME")=$$FMTISO^SDAMUTDT($GET(ARRAY298(2.98,PATIENS,7,"I")),CLINIEN)
+40 SET APPOINTMENT("PURPOSE")=$GET(ARRAY298(2.98,PATIENS,9,"E"))
+41 SET APPOINTMENT("COLLATERAL")=$GET(ARRAY298(2.98,PATIENS,13,"E"))
+42 SET APPOINTMENT("SCHEDULE REQUEST TYPE")=$GET(ARRAY298(2.98,PATIENS,25,"I"))
+43 SET APPOINTMENT("NEXT AVAILABLE APPOINTMENT")=$GET(ARRAY298(2.98,PATIENS,26,"I"))
+44 SET APPOINTMENT("FOLLOWUP")=$GET(ARRAY298(2.98,PATIENS,28,"E"))
+45 QUIT
VALAPPTLENGTHS(ERRORS,ORIGINALCLINIC,TARGETCLINIC,APPTIEN,TARGETDATETIME,AVAILSLOTS) ;
+1 NEW ORIGCLINVARLEN,TRGTCLINVARLEN,APPTLENGTH,TRGTCLINAPTLEN,APPTSTART
+2 SET ORIGCLINVARLEN=$SELECT($$GET1^DIQ(44,ORIGINALCLINIC,1913,"I")="V":1,1:0)
+3 SET TRGTCLINVARLEN=$SELECT($$GET1^DIQ(44,TARGETCLINIC,1913,"I")="V":1,1:0)
+4 SET TRGTCLINAPTLEN=$$GET1^DIQ(44,TARGETCLINIC,1912,"I")
+5 SET APPTLENGTH=$$GET1^DIQ(409.84,APPTIEN,.18,"I")
+6 IF ORIGCLINVARLEN
IF TRGTCLINVARLEN!('ORIGCLINVARLEN&TRGTCLINVARLEN)
Begin DoDot:1
+7 IF APPTLENGTH#TRGTCLINAPTLEN'=0
DO ERRLOG^SDES2JSON(.ERRORS,52,"Block and move appointment will not fit in the target clinic's schedule.")
QUIT
End DoDot:1
QUIT
+8 IF APPTLENGTH'=TRGTCLINAPTLEN
DO ERRLOG^SDES2JSON(.ERRORS,507)
+9 QUIT
