SDES2BLOCKANDMOV ;ALB/BLB,TJB,BLB - BLOCK AND MOVE ;MAY 23, 2024
;;5.3;Scheduling;**875,880,889**;Aug 13, 1993;Build 9
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
BLOCKANDMOVE(JSON,SDCONTEXT,BLOCKANDMOVE) ;
N RETURN,ERRORS,RESOURCEIEN,APPOINTMENT,JSONCANCEL,JSONCLINAVAIL,ORIGINALCLINIC,JSONAPPT,NEWAPPT,CANCELAPPT,CANCELAVAIL,OVERBOOK,VARIABLESLOTS
;
; populate vars
D POPULATE(.BLOCKANDMOVE,.APPTIEN,.TARGETCLINIC,.TARGETDATE,.ORIGINALCLINIC,.CANCELAPPT,.CANCELAVAIL,.VARIABLESLOTS)
;
; validate Block and Move
D VALIDATE(.ERRORS,.SDCONTEXT,$G(APPTIEN),$G(TARGETCLINIC),.TARGETDATE,.RESOURCEIEN,.OVERBOOK,.APPOINTMENT,.CANCELAVAIL,.CANCELAPPT,ORIGINALCLINIC,VARIABLESLOTS)
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSON,.RETURN) Q
;
; cancel original appointment
D CANCELAPPT^SDES2CANCELAPPT(.JSONCANCEL,.SDCONTEXT,.CANCELAPPT)
;
; block availability in original clinic slot
D CANCEL^SDES2CANCLNAVAIL(.JSONCLINAVAIL,.SDCONTEXT,.CANCELAVAIL)
;
; create new appointment in new slot
D BUILDAPPTARRAY(.APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC)
D CREATE^SDES2CREATEAPPT(.JSONAPPT,.SDCONTEXT,.APPOINTMENT)
D DECODE^XLFJSON("JSONAPPT","NEWAPPT")
;
S RETURN("BlockAndMoveAppointment","NewAppointmentIEN")=$G(NEWAPPT("Appointment","IEN"))
D BUILDJSON(.JSON,.RETURN)
Q
;
POPULATE(BLOCKANDMOVE,APPTIEN,TARGETCLINIC,TARGETDATE,ORIGINALCLINIC,CANCELAPPT,CANCELAVAIL,VARIABLESLOTS) ;
;
; block and move variables
S APPTIEN=$G(BLOCKANDMOVE("APPOINTMENT IEN"))
S TARGETCLINIC=$G(BLOCKANDMOVE("TARGET CLINIC"))
S TARGETDATE=$G(BLOCKANDMOVE("TARGET DATE TIME"))
S ORIGINALCLINIC=$$GET1^DIQ(409.831,$$GET1^DIQ(409.84,$G(APPTIEN),.07,"I"),.04,"I")
I $$GET1^DIQ(409.84,APPTIEN,.18,"I"),$$GET1^DIQ(44,ORIGINALCLINIC,1912,"I") D
.S VARIABLESLOTS=$$GET1^DIQ(409.84,APPTIEN,.18,"I")/$$GET1^DIQ(44,ORIGINALCLINIC,1912,"I")-1
S VARIABLESLOTS=$S($L($G(VARIABLESLOTS)):VARIABLESLOTS,1:0)
;
; cancel appointment array
S CANCELAPPT("APPT IEN")=APPTIEN
S CANCELAPPT("CLINIC IEN")=ORIGINALCLINIC
S CANCELAPPT("DFN")=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
S CANCELAPPT("CANCELLED BY")="C"
S CANCELAPPT("CANCEL REASON")="BLOCK AND MOVE"
;
; cancel clinic availability array
S CANCELAVAIL("CLINIC IEN")=ORIGINALCLINIC
S CANCELAVAIL("FULL PARTIAL FLAG")="P"
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("REMARKS")="BLOCK AND MOVE"
Q
;
VALIDATE(ERRORS,SDCONTEXT,APPTIEN,TARGETCLINIC,TARGETDATE,RESOURCEIEN,OVERBOOK,APPOINTMENT,CANCELAVAIL,CANCELAPPT,ORIGINALCLINIC,VARIABLESLOTS) ;
N ORIGINALSLOTS,TARGETSLOTS,SINC,STARTOFDAY,APPTARRAY,ARY84,ARY44,ARY2,VAL,FDA,ORIGINATINGSLOTS
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) Q
;
S RESOURCEIEN=$$GET1^DIQ(409.84,$G(APPTIEN),.07,"I")
D VALIDATEDATE(.ERRORS,.TARGETDATE,$G(TARGETCLINIC))
D VALIDATEAPPTIEN(.ERRORS,$G(APPTIEN),$G(TARGETDATE))
D VALIDATECLINIC(.ERRORS,$G(TARGETCLINIC))
I $D(ERRORS) Q
;
D PRIVILEGEDUSER(.ERRORS,$G(TARGETCLINIC),$S($G(SDCONTEXT("USER DUZ")):SDCONTEXT("USER DUZ"),1:DUZ))
D VALIDATECLINOPEN(.ERRORS,$G(TARGETCLINIC),$G(TARGETDATE))
D VALIDATELENGTHS(.ERRORS,RESOURCEIEN,$G(TARGETCLINIC),$G(APPTIEN))
D VALIDATETARGSLOT(.ERRORS,.TARGETSLOTS,TARGETCLINIC,TARGETDATE,$G(APPTIEN),.OVERBOOK)
D VALIDATEORIGSLOT(.ERRORS,.ORIGINATINGSLOTS,$$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),APPTIEN)
I $D(ERRORS) Q
;
; validate cancel appt
D VALPARAMS^SDES2CANCELAPPT(.CANCELAPPT,.ERRORS)
I $D(ERRORS) Q
;
; validate cancel clinic availability
D VALIDATE^SDES2CANCLNAVAIL(.ERRORS,.SDCONTEXT,.CANCELAVAIL,$G(CANCELAVAIL("CLINIC IEN")),$G(CANCELAVAIL("FULL PARTIAL FLAG")),$G(CANCELAVAIL("REMARKS")))
I $D(ERRORS) Q
;
; validate create appointment - status on request is opened prior to validating appointment to avoid hitting a false error for the request status in SDES2CREATEAPPT
S FDA(409.85,$P($$GET1^DIQ(409.84,APPTIEN,.22,"I"),";")_",",23)="O" D FILE^DIE(,"FDA") K FDA
D BUILDAPPTARRAY(.APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC)
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
;
; reset ISO times for cancel clin avail
S CANCELAVAIL("START DATE TIME")=$$FMTISO^SDAMUTDT($G(CANCELAVAIL("START DATE TIME")),ORIGINALCLINIC)
S CANCELAVAIL("END DATE TIME")=$$FMTISO^SDAMUTDT($G(CANCELAVAIL("END DATE TIME")),ORIGINALCLINIC)
;
Q
;
VALIDATETARGSLOT(ERRORS,TARGETSLOTS,TARGETCLINIC,TARGETSTARTDATE,APPTIEN,OVERBOOK) ;
N SLOTS,SLOTNUM,DONE
D GETCLAVAILABLTY^SDESCLINICAVAIL(.SLOTS,TARGETCLINIC,$$FMTISO^SDAMUTDT(TARGETSTARTDATE),$$FMTISO^SDAMUTDT($P(TARGETSTARTDATE,".")))
D DECODE^XLFJSON("SLOTS","TARGETSLOTS")
;
S SLOTNUM=0,OVERBOOK=""
F S SLOTNUM=$O(TARGETSLOTS("ClinAvail",SLOTNUM)) Q:'SLOTNUM!(OVERBOOK=1) D
.I $G(TARGETSLOTS("ClinAvail",SLOTNUM,"BeginTime"))=$$FMTISO^SDAMUTDT(TARGETSTARTDATE) D
..I '$G(TARGETSLOTS("ClinAvail",SLOTNUM,"SlotsAvail")),"abcdefghijklmnopqrstuvwxyz"'[$G(TARGETSLOTS("ClinAvail",SLOTNUM,"SlotsAvail")) S OVERBOOK="O"
Q
;
VALIDATEORIGSLOT(ERRORS,ORIGINATINGSLOTS,ORIGINALCLINIC,APPTDATE,APPTSTARTTIME,APPTIEN) ;
N SLOTS,COUNT,SLOTNUM,DONE,NUMBEROFAPPTS
;
S SLOTNUM=0,DONE=0,COUNT=1
D GETCLAVAILABLTY^SDESCLINICAVAIL(.SLOTS,ORIGINALCLINIC,$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),ORIGINALCLINIC),$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC))
D DECODE^XLFJSON("SLOTS","ORIGINATINGSLOTS")
;
F S SLOTNUM=$O(ORIGINATINGSLOTS("ClinAvail",SLOTNUM)) Q:'SLOTNUM!($D(ERRORS))!(DONE=1) D
.I $G(ORIGINATINGSLOTS("ClinAvail",SLOTNUM,"BeginTime"))=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC) S DONE=1 Q
.I $G(ORIGINATINGSLOTS("ClinAvail",SLOTNUM,"SlotsAvail"))'=0 D ERRLOG^SDES2JSON(.ERRORS,468) Q
.S DATETIME=$S(SLOTNUM=1:$$GET1^DIQ(409.84,APPTIEN,.01,"I"),1:$$FMADD^XLFDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),,,$$GET1^DIQ(44,ORIGINALCLINIC,1912,"I")*(SLOTNUM-1)))
.S NUMBEROFAPPTS=$$NUMBEROFAPPTS(ORIGINALCLINIC,DATETIME)
.I SLOTNUM=1,NUMBEROFAPPTS'=1 D ERRLOG^SDES2JSON(.ERRORS,468)
.I SLOTNUM>1,NUMBEROFAPPTS'=0 D ERRLOG^SDES2JSON(.ERRORS,468)
;
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
;
NUMBEROFAPPTS(CLINICIEN,DATETIME) ;
N COUNT
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
Q COUNT
;
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(409.84,APPTIEN,.18,"I")'=$$GET1^DIQ(44,TARGETCLINIC,1912) D ERRLOG^SDES2JSON(.ERRORS,507)
Q
;
PRIVILEGEDUSER(ERRORS,TARGETCLINIC,USERID) ;
I $$GET1^DIQ(44,TARGETCLINIC,2500,"I")="Y" D
.I '$D(^SC(TARGETCLINIC,"SDPRIV",USERID,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
;
BUILDJSON(JSON,CANRETURN) ;
N JSONERROR
D ENCODE^XLFJSON("CANRETURN","JSON","JSONERR")
Q
;
BUILDAPPTARRAY(APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC) ;
N ORIGINALAPPT,FMDATETIME,PATIENS,RESIEN,CLINIEN,SDDFN,ARRAY298,ARRAY44003,SDIEN,NOTEIDX
;
S FMDATETIME=$$ISOTFM^SDAMUTDT(TARGETDATE)
D GETS^DIQ(409.84,APPTIEN,"*","ZI","ORIGINALAPPT")
S SDDFN=$G(ORIGINALAPPT(409.84,APPTIEN_",",.05,"I"))
S PATIENS=$G(ORIGINALAPPT(409.84,APPTIEN_",",.01,"I"))_","_SDDFN_","
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")
S SDIEN=$$GET44RECORDIENS(CLINIEN,$G(ORIGINALAPPT(409.84,APPTIEN_",",.01,"I")),SDDFN)
D GETS^DIQ(44.003,SDIEN,"**","IE","ARRAY44003","SDMSG")
;
S APPOINTMENT("START DATE TIME")=$$FMTISO^SDAMUTDT(TARGETDATE)
S APPOINTMENT("END DATE TIME")=$$FMTISO^SDAMUTDT($$FMADD^XLFDT(TARGETDATE,,,$$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")=$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,SDIEN,3,"I"))
S APPOINTMENT("PATIENT ELIGIBILITY")=$G(ARRAY44003(44.003,SDIEN,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
;
GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,SDDFN,APPTOBJ) ;
;want to process through until we get to the correct appointment for time and clinic
N FOUND,IENS44003,SUBIEN,APPTCNT,MATCH
S FOUND=0,APPTCNT=0
S SUBIEN="A" F S SUBIEN=$O(^SC(CLINICIEN,"S",APPTSTARTTIME,1,SUBIEN),-1) Q:'SUBIEN!($G(FOUND)=1) D
.I $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",.01,"I")=SDDFN D
..S IENS44003=SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",FOUND=1 Q
Q $G(IENS44003)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2BLOCKANDMOV 12700 printed Dec 13, 2024@02:53:21 Page 2
SDES2BLOCKANDMOV ;ALB/BLB,TJB,BLB - BLOCK AND MOVE ;MAY 23, 2024
+1 ;;5.3;Scheduling;**875,880,889**;Aug 13, 1993;Build 9
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
BLOCKANDMOVE(JSON,SDCONTEXT,BLOCKANDMOVE) ;
+1 NEW RETURN,ERRORS,RESOURCEIEN,APPOINTMENT,JSONCANCEL,JSONCLINAVAIL,ORIGINALCLINIC,JSONAPPT,NEWAPPT,CANCELAPPT,CANCELAVAIL,OVERBOOK,VARIABLESLOTS
+2 ;
+3 ; populate vars
+4 DO POPULATE(.BLOCKANDMOVE,.APPTIEN,.TARGETCLINIC,.TARGETDATE,.ORIGINALCLINIC,.CANCELAPPT,.CANCELAVAIL,.VARIABLESLOTS)
+5 ;
+6 ; validate Block and Move
+7 DO VALIDATE(.ERRORS,.SDCONTEXT,$GET(APPTIEN),$GET(TARGETCLINIC),.TARGETDATE,.RESOURCEIEN,.OVERBOOK,.APPOINTMENT,.CANCELAVAIL,.CANCELAPPT,ORIGINALCLINIC,VARIABLESLOTS)
+8 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON(.JSON,.RETURN)
QUIT
+9 ;
+10 ; cancel original appointment
+11 DO CANCELAPPT^SDES2CANCELAPPT(.JSONCANCEL,.SDCONTEXT,.CANCELAPPT)
+12 ;
+13 ; block availability in original clinic slot
+14 DO CANCEL^SDES2CANCLNAVAIL(.JSONCLINAVAIL,.SDCONTEXT,.CANCELAVAIL)
+15 ;
+16 ; create new appointment in new slot
+17 DO BUILDAPPTARRAY(.APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC)
+18 DO CREATE^SDES2CREATEAPPT(.JSONAPPT,.SDCONTEXT,.APPOINTMENT)
+19 DO DECODE^XLFJSON("JSONAPPT","NEWAPPT")
+20 ;
+21 SET RETURN("BlockAndMoveAppointment","NewAppointmentIEN")=$GET(NEWAPPT("Appointment","IEN"))
+22 DO BUILDJSON(.JSON,.RETURN)
+23 QUIT
+24 ;
POPULATE(BLOCKANDMOVE,APPTIEN,TARGETCLINIC,TARGETDATE,ORIGINALCLINIC,CANCELAPPT,CANCELAVAIL,VARIABLESLOTS) ;
+1 ;
+2 ; block and move variables
+3 SET APPTIEN=$GET(BLOCKANDMOVE("APPOINTMENT IEN"))
+4 SET TARGETCLINIC=$GET(BLOCKANDMOVE("TARGET CLINIC"))
+5 SET TARGETDATE=$GET(BLOCKANDMOVE("TARGET DATE TIME"))
+6 SET ORIGINALCLINIC=$$GET1^DIQ(409.831,$$GET1^DIQ(409.84,$GET(APPTIEN),.07,"I"),.04,"I")
+7 IF $$GET1^DIQ(409.84,APPTIEN,.18,"I")
IF $$GET1^DIQ(44,ORIGINALCLINIC,1912,"I")
Begin DoDot:1
+8 SET VARIABLESLOTS=$$GET1^DIQ(409.84,APPTIEN,.18,"I")/$$GET1^DIQ(44,ORIGINALCLINIC,1912,"I")-1
End DoDot:1
+9 SET VARIABLESLOTS=$SELECT($LENGTH($GET(VARIABLESLOTS)):VARIABLESLOTS,1:0)
+10 ;
+11 ; cancel appointment array
+12 SET CANCELAPPT("APPT IEN")=APPTIEN
+13 SET CANCELAPPT("CLINIC IEN")=ORIGINALCLINIC
+14 SET CANCELAPPT("DFN")=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
+15 SET CANCELAPPT("CANCELLED BY")="C"
+16 SET CANCELAPPT("CANCEL REASON")="BLOCK AND MOVE"
+17 ;
+18 ; cancel clinic availability array
+19 SET CANCELAVAIL("CLINIC IEN")=ORIGINALCLINIC
+20 SET CANCELAVAIL("FULL PARTIAL FLAG")="P"
+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("REMARKS")="BLOCK AND MOVE"
+24 QUIT
+25 ;
VALIDATE(ERRORS,SDCONTEXT,APPTIEN,TARGETCLINIC,TARGETDATE,RESOURCEIEN,OVERBOOK,APPOINTMENT,CANCELAVAIL,CANCELAPPT,ORIGINALCLINIC,VARIABLESLOTS) ;
+1 NEW ORIGINALSLOTS,TARGETSLOTS,SINC,STARTOFDAY,APPTARRAY,ARY84,ARY44,ARY2,VAL,FDA,ORIGINATINGSLOTS
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
QUIT
+5 ;
+6 SET RESOURCEIEN=$$GET1^DIQ(409.84,$GET(APPTIEN),.07,"I")
+7 DO VALIDATEDATE(.ERRORS,.TARGETDATE,$GET(TARGETCLINIC))
+8 DO VALIDATEAPPTIEN(.ERRORS,$GET(APPTIEN),$GET(TARGETDATE))
+9 DO VALIDATECLINIC(.ERRORS,$GET(TARGETCLINIC))
+10 IF $DATA(ERRORS)
QUIT
+11 ;
+12 DO PRIVILEGEDUSER(.ERRORS,$GET(TARGETCLINIC),$SELECT($GET(SDCONTEXT("USER DUZ")):SDCONTEXT("USER DUZ"),1:DUZ))
+13 DO VALIDATECLINOPEN(.ERRORS,$GET(TARGETCLINIC),$GET(TARGETDATE))
+14 DO VALIDATELENGTHS(.ERRORS,RESOURCEIEN,$GET(TARGETCLINIC),$GET(APPTIEN))
+15 DO VALIDATETARGSLOT(.ERRORS,.TARGETSLOTS,TARGETCLINIC,TARGETDATE,$GET(APPTIEN),.OVERBOOK)
+16 DO VALIDATEORIGSLOT(.ERRORS,.ORIGINATINGSLOTS,$$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),AP
PTIEN)
+17 IF $DATA(ERRORS)
QUIT
+18 ;
+19 ; validate cancel appt
+20 DO VALPARAMS^SDES2CANCELAPPT(.CANCELAPPT,.ERRORS)
+21 IF $DATA(ERRORS)
QUIT
+22 ;
+23 ; validate cancel clinic availability
+24 DO VALIDATE^SDES2CANCLNAVAIL(.ERRORS,.SDCONTEXT,.CANCELAVAIL,$GET(CANCELAVAIL("CLINIC IEN")),$GET(CANCELAVAIL("FULL PARTIAL FLAG")),$GET(CANCELAVAIL("REMARKS")))
+25 IF $DATA(ERRORS)
QUIT
+26 ;
+27 ; validate create appointment - status on request is opened prior to validating appointment to avoid hitting a false error for the request status in SDES2CREATEAPPT
+28 SET FDA(409.85,$PIECE($$GET1^DIQ(409.84,APPTIEN,.22,"I"),";")_",",23)="O"
DO FILE^DIE(,"FDA")
KILL FDA
+29 DO BUILDAPPTARRAY(.APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC)
+30 DO VALIDATE^SDES2CREATEAPPT(.ERRORS,.SDCONTEXT,.APPOINTMENT,.VAL,1)
+31 SET FDA(409.85,$PIECE($$GET1^DIQ(409.84,APPTIEN,.22,"I"),";")_",",23)="C"
DO FILE^DIE(,"FDA")
KILL FDA
+32 ;
+33 ; reset ISO times for cancel clin avail
+34 SET CANCELAVAIL("START DATE TIME")=$$FMTISO^SDAMUTDT($GET(CANCELAVAIL("START DATE TIME")),ORIGINALCLINIC)
+35 SET CANCELAVAIL("END DATE TIME")=$$FMTISO^SDAMUTDT($GET(CANCELAVAIL("END DATE TIME")),ORIGINALCLINIC)
+36 ;
+37 QUIT
+38 ;
VALIDATETARGSLOT(ERRORS,TARGETSLOTS,TARGETCLINIC,TARGETSTARTDATE,APPTIEN,OVERBOOK) ;
+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 OVERBOOK=""
+6 FOR
SET SLOTNUM=$ORDER(TARGETSLOTS("ClinAvail",SLOTNUM))
if 'SLOTNUM!(OVERBOOK=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"))
IF "abcdefghijklmnopqrstuvwxyz"'[$GET(TARGETSLOTS("ClinAvail",SLOTNUM,"SlotsAvail"))
SET OVERBOOK="O"
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
VALIDATEORIGSLOT(ERRORS,ORIGINATINGSLOTS,ORIGINALCLINIC,APPTDATE,APPTSTARTTIME,APPTIEN) ;
+1 NEW SLOTS,COUNT,SLOTNUM,DONE,NUMBEROFAPPTS
+2 ;
+3 SET SLOTNUM=0
SET DONE=0
SET COUNT=1
+4 DO GETCLAVAILABLTY^SDESCLINICAVAIL(.SLOTS,ORIGINALCLINIC,$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),ORIGINALCLINIC),$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC))
+5 DO DECODE^XLFJSON("SLOTS","ORIGINATINGSLOTS")
+6 ;
+7 FOR
SET SLOTNUM=$ORDER(ORIGINATINGSLOTS("ClinAvail",SLOTNUM))
if 'SLOTNUM!($DATA(ERRORS))!(DONE=1)
QUIT
Begin DoDot:1
+8 IF $GET(ORIGINATINGSLOTS("ClinAvail",SLOTNUM,"BeginTime"))=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC)
SET DONE=1
QUIT
+9 IF $GET(ORIGINATINGSLOTS("ClinAvail",SLOTNUM,"SlotsAvail"))'=0
DO ERRLOG^SDES2JSON(.ERRORS,468)
QUIT
+10 SET DATETIME=$SELECT(SLOTNUM=1:$$GET1^DIQ(409.84,APPTIEN,.01,"I"),1:$$FMADD^XLFDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),,,$$GET1^DIQ(44,ORIGINALCLINIC,1912,"I")*(SLOTNUM-1)))
+11 SET NUMBEROFAPPTS=$$NUMBEROFAPPTS(ORIGINALCLINIC,DATETIME)
+12 IF SLOTNUM=1
IF NUMBEROFAPPTS'=1
DO ERRLOG^SDES2JSON(.ERRORS,468)
+13 IF SLOTNUM>1
IF NUMBEROFAPPTS'=0
DO ERRLOG^SDES2JSON(.ERRORS,468)
End DoDot:1
+14 ;
+15 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)
+16 QUIT
+17 ;
NUMBEROFAPPTS(CLINICIEN,DATETIME) ;
+1 NEW COUNT
+2 SET COUNT=0
SET SUBIEN=0
+3 FOR
SET SUBIEN=$ORDER(^SC(CLINICIEN,"S",DATETIME,1,SUBIEN))
if 'SUBIEN
QUIT
Begin DoDot:1
+4 IF $$GET1^DIQ(44.003,SUBIEN_","_DATETIME_","_CLINICIEN_",",310)="CANCELLED"
QUIT
+5 SET COUNT=COUNT+1
End DoDot:1
+6 QUIT COUNT
+7 ;
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(409.84,APPTIEN,.18,"I")'=$$GET1^DIQ(44,TARGETCLINIC,1912)
DO ERRLOG^SDES2JSON(.ERRORS,507)
+2 QUIT
+3 ;
PRIVILEGEDUSER(ERRORS,TARGETCLINIC,USERID) ;
+1 IF $$GET1^DIQ(44,TARGETCLINIC,2500,"I")="Y"
Begin DoDot:1
+2 IF '$DATA(^SC(TARGETCLINIC,"SDPRIV",USERID,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 ;
BUILDJSON(JSON,CANRETURN) ;
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("CANRETURN","JSON","JSONERR")
+3 QUIT
+4 ;
BUILDAPPTARRAY(APPOINTMENT,APPTIEN,TARGETDATE,TARGETCLINIC,OVERBOOK,ORIGINALCLINIC) ;
+1 NEW ORIGINALAPPT,FMDATETIME,PATIENS,RESIEN,CLINIEN,SDDFN,ARRAY298,ARRAY44003,SDIEN,NOTEIDX
+2 ;
+3 SET FMDATETIME=$$ISOTFM^SDAMUTDT(TARGETDATE)
+4 DO GETS^DIQ(409.84,APPTIEN,"*","ZI","ORIGINALAPPT")
+5 SET SDDFN=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.05,"I"))
+6 SET PATIENS=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.01,"I"))_","_SDDFN_","
+7 DO GETS^DIQ(2.98,PATIENS,"**","IE","ARRAY298","ERR")
+8 SET RESIEN=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.07,"I"))
+9 SET CLINIEN=$$GET1^DIQ(409.831,RESIEN_",",.04,"I")
+10 SET SDIEN=$$GET44RECORDIENS(CLINIEN,$GET(ORIGINALAPPT(409.84,APPTIEN_",",.01,"I")),SDDFN)
+11 DO GETS^DIQ(44.003,SDIEN,"**","IE","ARRAY44003","SDMSG")
+12 ;
+13 SET APPOINTMENT("START DATE TIME")=$$FMTISO^SDAMUTDT(TARGETDATE)
+14 SET APPOINTMENT("END DATE TIME")=$$FMTISO^SDAMUTDT($$FMADD^XLFDT(TARGETDATE,,,$$GET1^DIQ(409.84,APPTIEN,.18,"I")))
+15 SET APPOINTMENT("DFN")=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.05,"I"))
+16 SET APPOINTMENT("RESOURCE IEN")=$$GETRES^SDESINPUTVALUTL(TARGETCLINIC,1)
+17 SET APPOINTMENT("WALKIN")="N"
+18 SET APPOINTMENT("PATIENT INDICATED DATE")=$$FMTISO^SDAMUTDT($GET(ORIGINALAPPT(409.84,APPTIEN_",",.2,"I")))
+19 SET APPOINTMENT("EXTERNAL ID")=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.21,"I"))
+20 SET APPOINTMENT("REQUEST TYPE")=$EXTRACT($$GET1^DIQ(409.84,APPTIEN,.22,"E"),1,1)_"|"_$PIECE($GET(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";",1)
+21 SET APPOINTMENT("PROVIDER IEN")=$SELECT(TARGETCLINIC=ORIGINALCLINIC:$GET(ORIGINALAPPT(409.84,APPTIEN_",",.16,"I")),1:"")
+22 SET APPOINTMENT("CLINIC IEN")=TARGETCLINIC
+23 SET NOTEIDX=0
+24 SET APPOINTMENT("NOTE")=""
+25 FOR
SET NOTEIDX=$ORDER(ORIGINALAPPT(409.84,APPTIEN_",",1,NOTEIDX))
if +NOTEIDX=0
QUIT
Begin DoDot:1
+26 SET APPOINTMENT("NOTE")=APPOINTMENT("NOTE")_ORIGINALAPPT(409.84,APPTIEN_",",1,NOTEIDX,0)
End DoDot:1
+27 SET APPOINTMENT("APPOINTMENT TYPE")=""
+28 SET APPOINTMENT("APPOINTMENT TYPE NAME")=$$GET1^DIQ(409.1,$GET(ORIGINALAPPT(409.84,APPTIEN_",",.06,"I")),.01,"E")
+29 SET APPOINTMENT("PATIENT STATUS")=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.23,"I"))
+30 SET APPOINTMENT("APPOINTMENT LENGTH")=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.18,"I"))
+31 ;looking do not see why this is being sent, doesn't update in appointment
SET APPOINTMENT("SERVICE CONNECTED")=""
+32 ; doesn't update in appointment
SET APPOINTMENT("SERVICE CONNECTED PERCENTAGE")=""
+33 IF $$GET1^DIQ(409.85,$PIECE($GET(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8)
Begin DoDot:1
+34 SET APPOINTMENT("MRTC")="TRUE"
+35 SET APPOINTMENT("MRTC PARENT")=$$GET1^DIQ(409.85,$PIECE($GET(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8)
End DoDot:1
+36 SET APPOINTMENT("APPOINTMENT REASON")=$GET(ARRAY44003(44.003,SDIEN,3,"I"))
+37 SET APPOINTMENT("PATIENT ELIGIBILITY")=$GET(ARRAY44003(44.003,SDIEN,30,"I"))
+38 SET APPOINTMENT("OVERBOOK")=OVERBOOK
+39 SET APPOINTMENT("LAB DATE TIME")=$$FMTISO^SDAMUTDT($GET(ARRAY298(2.98,PATIENS,5,"I")),CLINIEN)
+40 SET APPOINTMENT("XRAY DATE TIME")=$$FMTISO^SDAMUTDT($GET(ARRAY298(2.98,PATIENS,6,"I")),CLINIEN)
+41 SET APPOINTMENT("EKG DATE TIME")=$$FMTISO^SDAMUTDT($GET(ARRAY298(2.98,PATIENS,7,"I")),CLINIEN)
+42 SET APPOINTMENT("PURPOSE")=$GET(ARRAY298(2.98,PATIENS,9,"E"))
+43 SET APPOINTMENT("COLLATERAL")=$GET(ARRAY298(2.98,PATIENS,13,"E"))
+44 SET APPOINTMENT("SCHEDULE REQUEST TYPE")=$GET(ARRAY298(2.98,PATIENS,25,"I"))
+45 SET APPOINTMENT("NEXT AVAILABLE APPOINTMENT")=$GET(ARRAY298(2.98,PATIENS,26,"I"))
+46 SET APPOINTMENT("FOLLOWUP")=$GET(ARRAY298(2.98,PATIENS,28,"E"))
+47 QUIT
+48 ;
GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,SDDFN,APPTOBJ) ;
+1 ;want to process through until we get to the correct appointment for time and clinic
+2 NEW FOUND,IENS44003,SUBIEN,APPTCNT,MATCH
+3 SET FOUND=0
SET APPTCNT=0
+4 SET SUBIEN="A"
FOR
SET SUBIEN=$ORDER(^SC(CLINICIEN,"S",APPTSTARTTIME,1,SUBIEN),-1)
if 'SUBIEN!($GET(FOUND)=1)
QUIT
Begin DoDot:1
+5 IF $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",.01,"I")=SDDFN
Begin DoDot:2
+6 SET IENS44003=SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_","
SET FOUND=1
QUIT
End DoDot:2
End DoDot:1
+7 QUIT $GET(IENS44003)
+8 ;
