SDESBLOCKANDMOVE ;ALB/BLB,LAB - SCHEDULING CANCEL APPOINTMENTS RPC ;DEC 12, 2023
;;5.3;Scheduling;**853,866,867**;Aug 13, 1993;Build 8
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
BLOCKANDMOVE(JSON,BLOCKANDMOVE) ;
N RETURN,ERRORS,RESOURCEIEN,APPTARRAY,JSONCANCEL,CANCELCLINAVAIL,ORIGINALCLINIC,JSONAPPT,CONTEXT,NEWAPPT
;
; populate vars
D POPULATE(.APPTIEN,.TARGETCLINIC,.TARGETDATE,.ORIGINALCLINIC)
;
; validate Block and Move
D VALIDATE(.ERRORS,.CONTEXT,$G(APPTIEN),$G(TARGETCLINIC),.TARGETDATE,.RESOURCEIEN)
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSON,.RETURN) Q
;
; cancel original appointment
D CANAPPT2^SDESCANAPPT2(.JSONCANCEL,APPTIEN,ORIGINALCLINIC,$$GET1^DIQ(409.84,APPTIEN,.05,"I"),"C","BLOCK AND MOVE")
;
; block availability in original clinic slot
D CANCLAVAIL^SDESCCAVAIL(.CANCELCLINAVAIL,ORIGINALCLINIC,"P",$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),ORIGINALCLINIC),$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC))
;
; create new appointment in new slot
D BUILDAPPTARRAY(.APPTARRAY,TARGETDATE,TARGETCLINIC,APPTIEN)
D CREATEAPPTS^SDESCRTAPPTWRAP(.JSONAPPT,.APPTARRAY)
D DECODE^XLFJSON("JSONAPPT","NEWAPPT")
;
S RETURN("BlockAndMoveAppointment","NewAppointmentIEN")=$G(NEWAPPT("Appointment","IEN"))
D BUILDJSON(.JSON,.RETURN)
Q
;
POPULATE(APPTIEN,TARGETCLINIC,TARGETDATE,ORIGINALCLINIC) ;
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")
Q
;
VALIDATE(ERRORS,CONTEXT,APPTIEN,TARGETCLINIC,TARGETDATE,RESOURCEIEN) ;
N ORIGINALSLOTS,TARGETSLOTS,SINC,STARTOFDAY,APPTARRAY,ARY84,ARY44,ARY2
;
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))
D VALIDATECLINOPEN(.ERRORS,$G(TARGETCLINIC),$G(TARGETDATE))
D VALIDATELENGTHS(.ERRORS,RESOURCEIEN,$G(TARGETCLINIC),$G(APPTIEN))
D VALIDATETARGSLOT(.ERRORS,.TARGETSLOTS,TARGETCLINIC,TARGETDATE,$G(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^SDESJSON(.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^SDESJSON(.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^SDESJSON(.ERRORS,469)
Q
;
VALIDATEAPPTIEN(ERRORS,APPTIEN,TARGETDATE) ;
I APPTIEN="" D ERRLOG^SDESJSON(.ERRORS,14) Q
I APPTIEN'="",'$D(^SDEC(409.84,APPTIEN,0)) D ERRLOG^SDESJSON(.ERRORS,15) Q
I $P($$GET1^DIQ(409.84,APPTIEN,.01,"I"),".")'=$P($$GET1^DIQ(409.84,APPTIEN,.02,"I"),".") D ERRLOG^SDESJSON(.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^SDESJSON(.ERRORS,463)
Q
;
VALIDATECLINIC(ERRORS,TARGETCLINIC) ;
I TARGETCLINIC="" D ERRLOG^SDESJSON(.ERRORS,18) Q
I TARGETCLINIC'="",'$D(^SC(TARGETCLINIC,0)) D ERRLOG^SDESJSON(.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^SDESJSON(.ERRORS,344)
I '$G(^SC(TARGETCLINIC,"ST",$P(TARGETDATE,"."),0)) D ERRLOG^SDESJSON(.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^SDESJSON(.ERRORS,500)
I $$GET1^DIQ(409.84,APPTIEN,.18,"I")'=$$GET1^DIQ(44,$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I"),1912) D ERRLOG^SDESJSON(.ERRORS,507)
Q
;
PRIVILEGEDUSER(ERRORS,TARGETCLINIC) ;
I $$GET1^DIQ(44,TARGETCLINIC,2500,"I")="Y" D
.I '$D(^SC(TARGETCLINIC,"SDPRIV",DUZ,0)) D ERRLOG^SDESJSON(.ERRORS,343)
Q
;
VALIDATEDATE(ERRORS,DATE,CLINICIEN) ;
I DATE="" D ERRLOG^SDESJSON(.ERRORS,9) Q
S DATE=$$ISOTFM^SDAMUTDT(DATE)
I DATE=-1 D ERRLOG^SDESJSON(.ERRORS,11) Q
I '$P(DATE,".",2) D ERRLOG^SDESJSON(.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^SDESJSON(.ERRORS,465)
Q
;
BUILDJSON(JSON,CANRETURN) ;.
N JSONERROR
D ENCODE^XLFJSON("CANRETURN","JSON","JSONERR")
Q
;
BUILDAPPTARRAY(APPTARRAY,TARGETDATE,TARGETCLINIC,APPTIEN) ;
N ORIGINALAPPT
D GETS^DIQ(409.84,APPTIEN,"*","ZI","ORIGINALAPPT")
;
S APPTARRAY(1)=$$FMTISO^SDAMUTDT(TARGETDATE)
S APPTARRAY(2)=$$FMTISO^SDAMUTDT($$FMADD^XLFDT(TARGETDATE,,,$$GET1^DIQ(409.84,APPTIEN,.18,"I")))
S APPTARRAY(3)=$G(ORIGINALAPPT(409.84,APPTIEN_",",.05,"I"))
S APPTARRAY(4)=$$GETRES^SDESINPUTVALUTL(TARGETCLINIC,1)
S APPTARRAY(5)=""
S APPTARRAY(6)=$$FMTISO^SDAMUTDT($G(ORIGINALAPPT(409.84,APPTIEN_",",.2,"I")))
S APPTARRAY(7)=""
S APPTARRAY(8)=$E($$GET1^DIQ(409.84,APPTIEN,.22,"E"),1,1)_"|"_$P($G(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";",1)
S APPTARRAY(9)=$G(ORIGINALAPPT(409.84,APPTIEN_",",.16,"I"))
S APPTARRAY(10)=TARGETCLINIC
S APPTARRAY(11)=$G(ORIGINALAPPT(409.84,APPTIEN_",",.1,"I"))
S APPTARRAY(12.5)=$$GET1^DIQ(409.1,$G(ORIGINALAPPT(409.84,APPTIEN_",",.06,"I")),.01,"E")
S APPTARRAY(13)=$G(ORIGINALAPPT(409.84,APPTIEN_",",.23,"I"))
S APPTARRAY(14)=$G(ORIGINALAPPT(409.84,APPTIEN_",",.18,"I"))
S APPTARRAY(15)=""
S APPTARRAY(16)=""
I $$GET1^DIQ(409.85,$P($G(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8) D
.S APPTARRAY(17)="TRUE"
.S APPTARRAY(18)=$$GET1^DIQ(409.85,$P($G(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8)
S APPTARRAY(19)=$G(ORIGINALAPPT(409.84,APPTIEN_",",100,"I"))
S APPTARRAY(20)=""
S APPTARRAY(21)=""
S APPTARRAY(22)=""
S APPTARRAY(23)=""
S APPTARRAY(24)=""
S APPTARRAY(25)=""
S APPTARRAY(26)=3
S APPTARRAY(27)=""
S APPTARRAY(28)="P"
S APPTARRAY(29)=0
S APPTARRAY(30)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESBLOCKANDMOVE 7357 printed May 21, 2024@02:44:33 Page 2
SDESBLOCKANDMOVE ;ALB/BLB,LAB - SCHEDULING CANCEL APPOINTMENTS RPC ;DEC 12, 2023
+1 ;;5.3;Scheduling;**853,866,867**;Aug 13, 1993;Build 8
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
BLOCKANDMOVE(JSON,BLOCKANDMOVE) ;
+1 NEW RETURN,ERRORS,RESOURCEIEN,APPTARRAY,JSONCANCEL,CANCELCLINAVAIL,ORIGINALCLINIC,JSONAPPT,CONTEXT,NEWAPPT
+2 ;
+3 ; populate vars
+4 DO POPULATE(.APPTIEN,.TARGETCLINIC,.TARGETDATE,.ORIGINALCLINIC)
+5 ;
+6 ; validate Block and Move
+7 DO VALIDATE(.ERRORS,.CONTEXT,$GET(APPTIEN),$GET(TARGETCLINIC),.TARGETDATE,.RESOURCEIEN)
+8 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON(.JSON,.RETURN)
QUIT
+9 ;
+10 ; cancel original appointment
+11 DO CANAPPT2^SDESCANAPPT2(.JSONCANCEL,APPTIEN,ORIGINALCLINIC,$$GET1^DIQ(409.84,APPTIEN,.05,"I"),"C","BLOCK AND MOVE")
+12 ;
+13 ; block availability in original clinic slot
+14 DO CANCLAVAIL^SDESCCAVAIL(.CANCELCLINAVAIL,ORIGINALCLINIC,"P",$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),ORIGINALCLINIC),$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.02,"I"),ORIGINALCLINIC))
+15 ;
+16 ; create new appointment in new slot
+17 DO BUILDAPPTARRAY(.APPTARRAY,TARGETDATE,TARGETCLINIC,APPTIEN)
+18 DO CREATEAPPTS^SDESCRTAPPTWRAP(.JSONAPPT,.APPTARRAY)
+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(APPTIEN,TARGETCLINIC,TARGETDATE,ORIGINALCLINIC) ;
+1 SET APPTIEN=$GET(BLOCKANDMOVE("APPOINTMENT IEN"))
+2 SET TARGETCLINIC=$GET(BLOCKANDMOVE("TARGET CLINIC"))
+3 SET TARGETDATE=$GET(BLOCKANDMOVE("TARGET DATE TIME"))
+4 SET ORIGINALCLINIC=$$GET1^DIQ(409.831,$$GET1^DIQ(409.84,$GET(APPTIEN),.07,"I"),.04,"I")
+5 QUIT
+6 ;
VALIDATE(ERRORS,CONTEXT,APPTIEN,TARGETCLINIC,TARGETDATE,RESOURCEIEN) ;
+1 NEW ORIGINALSLOTS,TARGETSLOTS,SINC,STARTOFDAY,APPTARRAY,ARY84,ARY44,ARY2
+2 ;
+3 SET RESOURCEIEN=$$GET1^DIQ(409.84,$GET(APPTIEN),.07,"I")
+4 DO VALIDATEDATE(.ERRORS,.TARGETDATE,$GET(TARGETCLINIC))
+5 DO VALIDATEAPPTIEN(.ERRORS,$GET(APPTIEN),$GET(TARGETDATE))
+6 DO VALIDATECLINIC(.ERRORS,$GET(TARGETCLINIC))
+7 IF $DATA(ERRORS)
QUIT
+8 ;
+9 DO PRIVILEGEDUSER(.ERRORS,$GET(TARGETCLINIC))
+10 DO VALIDATECLINOPEN(.ERRORS,$GET(TARGETCLINIC),$GET(TARGETDATE))
+11 DO VALIDATELENGTHS(.ERRORS,RESOURCEIEN,$GET(TARGETCLINIC),$GET(APPTIEN))
+12 DO VALIDATETARGSLOT(.ERRORS,.TARGETSLOTS,TARGETCLINIC,TARGETDATE,$GET(APPTIEN))
+13 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))
+14 QUIT
+15 ;
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^SDESJSON(.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^SDESJSON(.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^SDESJSON(.ERRORS,469)
+9 QUIT
+10 ;
VALIDATEAPPTIEN(ERRORS,APPTIEN,TARGETDATE) ;
+1 IF APPTIEN=""
DO ERRLOG^SDESJSON(.ERRORS,14)
QUIT
+2 IF APPTIEN'=""
IF '$DATA(^SDEC(409.84,APPTIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,15)
QUIT
+3 IF $PIECE($$GET1^DIQ(409.84,APPTIEN,.01,"I"),".")'=$PIECE($$GET1^DIQ(409.84,APPTIEN,.02,"I"),".")
DO ERRLOG^SDESJSON(.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^SDESJSON(.ERRORS,463)
+5 QUIT
+6 ;
VALIDATECLINIC(ERRORS,TARGETCLINIC) ;
+1 IF TARGETCLINIC=""
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT
+2 IF TARGETCLINIC'=""
IF '$DATA(^SC(TARGETCLINIC,0))
DO ERRLOG^SDESJSON(.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^SDESJSON(.ERRORS,344)
+6 IF '$GET(^SC(TARGETCLINIC,"ST",$PIECE(TARGETDATE,"."),0))
DO ERRLOG^SDESJSON(.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^SDESJSON(.ERRORS,500)
+2 IF $$GET1^DIQ(409.84,APPTIEN,.18,"I")'=$$GET1^DIQ(44,$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I"),1912)
DO ERRLOG^SDESJSON(.ERRORS,507)
+3 QUIT
+4 ;
PRIVILEGEDUSER(ERRORS,TARGETCLINIC) ;
+1 IF $$GET1^DIQ(44,TARGETCLINIC,2500,"I")="Y"
Begin DoDot:1
+2 IF '$DATA(^SC(TARGETCLINIC,"SDPRIV",DUZ,0))
DO ERRLOG^SDESJSON(.ERRORS,343)
End DoDot:1
+3 QUIT
+4 ;
VALIDATEDATE(ERRORS,DATE,CLINICIEN) ;
+1 IF DATE=""
DO ERRLOG^SDESJSON(.ERRORS,9)
QUIT
+2 SET DATE=$$ISOTFM^SDAMUTDT(DATE)
+3 IF DATE=-1
DO ERRLOG^SDESJSON(.ERRORS,11)
QUIT
+4 IF '$PIECE(DATE,".",2)
DO ERRLOG^SDESJSON(.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^SDESJSON(.ERRORS,465)
+7 QUIT
+8 ;
BUILDJSON(JSON,CANRETURN) ;.
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("CANRETURN","JSON","JSONERR")
+3 QUIT
+4 ;
BUILDAPPTARRAY(APPTARRAY,TARGETDATE,TARGETCLINIC,APPTIEN) ;
+1 NEW ORIGINALAPPT
+2 DO GETS^DIQ(409.84,APPTIEN,"*","ZI","ORIGINALAPPT")
+3 ;
+4 SET APPTARRAY(1)=$$FMTISO^SDAMUTDT(TARGETDATE)
+5 SET APPTARRAY(2)=$$FMTISO^SDAMUTDT($$FMADD^XLFDT(TARGETDATE,,,$$GET1^DIQ(409.84,APPTIEN,.18,"I")))
+6 SET APPTARRAY(3)=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.05,"I"))
+7 SET APPTARRAY(4)=$$GETRES^SDESINPUTVALUTL(TARGETCLINIC,1)
+8 SET APPTARRAY(5)=""
+9 SET APPTARRAY(6)=$$FMTISO^SDAMUTDT($GET(ORIGINALAPPT(409.84,APPTIEN_",",.2,"I")))
+10 SET APPTARRAY(7)=""
+11 SET APPTARRAY(8)=$EXTRACT($$GET1^DIQ(409.84,APPTIEN,.22,"E"),1,1)_"|"_$PIECE($GET(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";",1)
+12 SET APPTARRAY(9)=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.16,"I"))
+13 SET APPTARRAY(10)=TARGETCLINIC
+14 SET APPTARRAY(11)=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.1,"I"))
+15 SET APPTARRAY(12.5)=$$GET1^DIQ(409.1,$GET(ORIGINALAPPT(409.84,APPTIEN_",",.06,"I")),.01,"E")
+16 SET APPTARRAY(13)=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.23,"I"))
+17 SET APPTARRAY(14)=$GET(ORIGINALAPPT(409.84,APPTIEN_",",.18,"I"))
+18 SET APPTARRAY(15)=""
+19 SET APPTARRAY(16)=""
+20 IF $$GET1^DIQ(409.85,$PIECE($GET(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8)
Begin DoDot:1
+21 SET APPTARRAY(17)="TRUE"
+22 SET APPTARRAY(18)=$$GET1^DIQ(409.85,$PIECE($GET(ORIGINALAPPT(409.84,APPTIEN_",",.22,"I")),";"),43.8)
End DoDot:1
+23 SET APPTARRAY(19)=$GET(ORIGINALAPPT(409.84,APPTIEN_",",100,"I"))
+24 SET APPTARRAY(20)=""
+25 SET APPTARRAY(21)=""
+26 SET APPTARRAY(22)=""
+27 SET APPTARRAY(23)=""
+28 SET APPTARRAY(24)=""
+29 SET APPTARRAY(25)=""
+30 SET APPTARRAY(26)=3
+31 SET APPTARRAY(27)=""
+32 SET APPTARRAY(28)="P"
+33 SET APPTARRAY(29)=0
+34 SET APPTARRAY(30)=""
+35 QUIT
+36 ;
