SDESCREATEAPPT44 ;ALB/BLB,DJS,BLB,TJB - SDES CREATE APPOINTMENT ;Jun 17, 2024
;;5.3;Scheduling;**814,823,827,851,877,881**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
; create appt in file 44. Called from wrapper level SDESCRTAPPTWRAP. See SDESCRTAPPTWRAP for required inputs.
;
;
VALIDATE(ERRORS,ARY44) ;
;
N HAS44APPT,SDDA
;
; clinic IEN
S ARY44("CLINICIEN")=$G(ARY44("CLINICIEN"),"")
I ARY44("CLINICIEN")="" D ERRLOG^SDESJSON(.ERRORS,18) Q
I '$D(^SC(+ARY44("CLINICIEN"),0)) D ERRLOG^SDESJSON(.ERRORS,19) Q
I $$INACTIVE^SDEC32(+ARY44("CLINICIEN")) D ERRLOG^SDESJSON(.ERRORS,19) Q
;
; patient DFN
S ARY44("DFN")=$G(ARY44("DFN"),"")
I ARY44("DFN")="" D ERRLOG^SDESJSON(.ERRORS,1) Q
I ARY44("DFN")'="",'$D(^DPT(+ARY44("DFN"),0)) D ERRLOG^SDESJSON(.ERRORS,2) Q
;
; desired date/time of appt
S ARY44("SDAPPTSTARTDTTM")=$G(ARY44("SDAPPTSTARTDTTM"),"")
I ARY44("SDAPPTSTARTDTTM")="" D ERRLOG^SDESJSON(.ERRORS,57) Q
S ARY44("SDAPPTSTARTDTTM")=$$ISOTFM^SDAMUTDT(ARY44("SDAPPTSTARTDTTM"),ARY44("CLINICIEN")) ; vse-2397 clinic time zone
I ARY44("SDAPPTSTARTDTTM")=-1 S ARY44("SDAPPTSTARTDTTM")="" D ERRLOG^SDESJSON(.ERRORS,58) Q
;I ARY44("SDAPPTSTARTDTTM")<DT D ERRLOG^SDESJSON(.ERRORS,59) Q ;Only validate on Create, Allow Appointments made in the Past
;
; appointment Length in Minutes
S ARY44("SDAPPTLENGTH")=$G(ARY44("SDAPPTLENGTH"),"")
I ARY44("SDAPPTLENGTH")="" D ERRLOG^SDESJSON(.ERRORS,115) Q
I ARY44("SDAPPTLENGTH")'="",((+ARY44("SDAPPTLENGTH")<5)!(+ARY44("SDAPPTLENGTH")>240)) D ERRLOG^SDESJSON(.ERRORS,116) Q
;
; appointment Reason
S ARY44("SDAPPTREASON")=$G(ARY44("SDAPPTREASON"),"")
S ARY44("SDAPPTREASON")=$TR($G(ARY44("SDAPPTREASON")),"^"," ")
;
; overbook
S ARY44("SDOVERBOOK")=$G(ARY44("SDOVERBOOK"),"")
I ARY44("SDOVERBOOK")'="" D
. I ARY44("SDOVERBOOK")'=1,ARY44("SDOVERBOOK")'=0 D ERRLOG^SDESJSON(.ERRORS,112) Q
;
; patient Eligibility
S ARY44("SDPATELIG")=$G(ARY44("SDPATELIG"),"")
I ARY44("SDPATELIG")'="",'$D(^DIC(8,+ARY44("SDPATELIG"),0)) D ERRLOG^SDESJSON(.ERRORS,143) Q
;
; check for existing appointment in clinic for same patient/date/time
S HAS44APPT=$$APPTIN44EXISTS(ARY44("DFN"),ARY44("CLINICIEN"),ARY44("SDAPPTSTARTDTTM"))
I HAS44APPT D ERRLOG^SDESJSON(.ERRORS,175) Q
;
Q
APPTIN44EXISTS(DFN,CLINIC,DATE) ;
N SUBIEN,FOUND
S FOUND=0
S SUBIEN=0 F S SUBIEN=$O(^SC(CLINIC,"S",DATE,1,SUBIEN)) Q:'SUBIEN!($G(FOUND)=1) D
.I $$GET1^DIQ(44.003,SUBIEN_","_DATE_","_CLINIC_",",310)="CANCELLED" Q ;cancelled
.I $$GET1^DIQ(44.003,SUBIEN_","_DATE_","_CLINIC_",",.01,"I")=DFN S FOUND=1 Q ; record exists
I $G(FOUND)=1 Q 1
Q 0
;
CREATE(ARRAY44001FDA,ARRAY44003FDA,NEWIEN44001,IENS44,ARY44) ;
;
; only allow one entry in 44.001 for a single date
I '$D(^SC($G(ARY44("CLINICIEN")),"S",$G(ARY44("SDAPPTSTARTDTTM")))) D
.S NEWIEN44001(1)=ARY44("SDAPPTSTARTDTTM")
.S ARRAY44001FDA(44.001,"+1,"_$G(ARY44("CLINICIEN"))_",",.01)=$G(ARY44("SDAPPTSTARTDTTM"))
S IENS44(1)=ARY44("SDAPPTSTARTDTTM")_","_ARY44("CLINICIEN")_","
S ARRAY44003FDA(44.003,"+1,"_IENS44(1),.01)=$G(ARY44("DFN"))
S ARRAY44003FDA(44.003,"+1,"_IENS44(1),1)=$G(ARY44("SDAPPTLENGTH"))
S ARRAY44003FDA(44.003,"+1,"_IENS44(1),3)=$E($G(ARY44("SDAPPTREASON")),1,150)
S ARRAY44003FDA(44.003,"+1,"_IENS44(1),30)=$G(ARY44("SDPATELIG"))
S ARRAY44003FDA(44.003,"+1,"_IENS44(1),9)=$S(+ARY44("SDOVERBOOK"):"O",1:"")
S ARRAY44003FDA(44.003,"+1,"_IENS44(1),7)=$G(DUZ)
S ARRAY44003FDA(44.003,"+1,"_IENS44(1),8)=$$NOW^XLFDT
Q
CLEANUP44(ARY44,NEWIEN44,SDREQTYPE) ;
;add consult link
I $P(ARY44("SDREQTYPE"),"|",1)="C" D
.N SDFDA
.S SDFDA(44.003,NEWIEN44_","_ARY44("SDAPPTSTARTDTTM")_","_ARY44("CLINICIEN")_",",688)=$P(SDREQTYPE,"|",2)
.D UPDATE^DIE("","SDFDA") K SDFDA
;
;make appt event #1
S SDDA=$$SCIEN^SDECU2($G(ARY44("DFN")),$G(ARY44("CLINICIEN")),$G(ARY44("SDAPPTSTARTDTTM")))
D MAKE^SDAMEVT($G(ARY44("DFN")),$G(ARY44("SDAPPTSTARTDTTM")),$G(ARY44("CLINICIEN")),SDDA,2)
;update clinic availability
D DECREMENTAVAIL1($G(ARY44("CLINICIEN")),$G(ARY44("SDAPPTSTARTDTTM")),$G(ARY44("SDAPPTLENGTH")))
Q
;
DECREMENTAVAIL1(CLINICIEN,APPTSTARTTIME,APPTLENGTH) ;
N COUNT,CLINICAPPTLENGTH,NUMOFSLOTSINPLAY
S CLINICAPPTLENGTH=+$E($$GET1^DIQ(44,CLINICIEN,1917,"E"),1,2)
S NUMOFSLOTSINPLAY=APPTLENGTH/CLINICAPPTLENGTH
F COUNT=1:1:NUMOFSLOTSINPLAY D
.I COUNT>1 D
..S APPTSTARTTIME=$$FMADD^XLFDT(APPTSTARTTIME,,,CLINICAPPTLENGTH)
.D DECREMENTAVAIL2(CLINICIEN,APPTSTARTTIME,APPTLENGTH)
Q
;
DECREMENTAVAIL2(CLINICIEN,APPTSTARTTIME,APPTLENGTH) ;decrement availability by one when creating appointment
N SLOTINCREMENT,SLOTSTATUSSTRING,CURRENTSCHEDULE,NEWSCHEDULE,TIMECLINICOPENS,SLOTLENGTH,NEWAVAILABILITY,SPECIALCHARACTER,AVAILABILITYFDA,CENTEROFSLOT,CHARMULTIPLIER,MAXDAYSINFUTURE
;
S CURRENTSCHEDULE=$$GET1^DIQ(44.005,$P(APPTSTARTTIME,".")_","_CLINICIEN_",",1)
S TIMECLINICOPENS=$S($L($$GET1^DIQ(44,CLINICIEN,1914,"I")):$$GET1^DIQ(44,CLINICIEN,1914,"I"),1:8)-1/100
S SLOTLENGTH=$S($$GET1^DIQ(44,CLINICIEN,1917,"I"):$$GET1^DIQ(44,CLINICIEN,1917,"I"),1:4)
S SLOTINCREMENT=$S('$$GET1^DIQ(44,CLINICIEN,1917,"I"):4,$$GET1^DIQ(44,CLINICIEN,1917,"I")<3:4,$$GET1^DIQ(44,CLINICIEN,1917,"I"):$$GET1^DIQ(44,CLINICIEN,1917,"I"),1:4)
S CHARMULTIPLIER=$S(SLOTLENGTH<3:8/SLOTLENGTH,1:2)
S NEWAVAILABILITY=APPTSTARTTIME#1-TIMECLINICOPENS*100
S CENTEROFSLOT=NEWAVAILABILITY#1*SLOTINCREMENT\.6+(NEWAVAILABILITY\1*SLOTINCREMENT)*2
S MAXDAYSINFUTURE=$$GET1^DIQ(44,CLINICIEN,2002,"I")
S SLOTSTATUSSTRING="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
;
I $P(APPTSTARTTIME,".")>$$FMADD^XLFDT(DT,MAXDAYSINFUTURE) D ERRLOG^SDESJSON(.ERRORS,491) Q
;
I '$D(^SC(CLINICIEN,"ST",$P(APPTSTARTTIME,"."),1)) D
.D ASSEMBLE^SDESCLINDAILYSCH(.ERRORS,CLINICIEN,$P(APPTSTARTTIME,"."),$$GET1^DIQ(44,CLINICIEN,1917,"I"),TIMECLINICOPENS)
;
I $D(^SC(CLINICIEN,"ST",$P(APPTSTARTTIME,"."),"CAN"))!(CURRENTSCHEDULE["CAN") D ERRLOG^SDESJSON(.ERRORS,492)
;
F SPECIALCHARACTER=CENTEROFSLOT:CHARMULTIPLIER Q:$L($G(NEWSCHEDULE))!($G(NEWAVAILABILITY)="") D
.S NEWAVAILABILITY=$E(SLOTSTATUSSTRING,$F(SLOTSTATUSSTRING,$E(CURRENTSCHEDULE,SPECIALCHARACTER+1))-2)
.S NEWSCHEDULE=$E(CURRENTSCHEDULE,1,SPECIALCHARACTER)_NEWAVAILABILITY_$E(CURRENTSCHEDULE,SPECIALCHARACTER+2,999)
;
S AVAILABILITYFDA(44.005,$P(APPTSTARTTIME,".")_","_CLINICIEN_",",1)=NEWSCHEDULE
D FILE^DIE(,"AVAILABILITYFDA") K AVAILABILITYFDA
Q
;
AVUPDT(SDECSCD,SDECSTART,SDECLEN) ;
N HSI,I,S,SB,SD,SDDIF,SI,SL,SS,ST,STARTDAY,STR,X,Y
S (SD,S)=SDECSTART
S I=SDECSCD
Q:'$D(^SC(I,"ST",SD\1,1))
S SL=^SC(I,"SL"),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2)
S SL=SDECLEN
S S=^SC(I,"ST",SD\1,1),Y=SD#1-SB*100,ST=Y#1*SI\.6+(Y\1*SI),SS=SL*HSI/60
I Y'<1 F I=ST+ST:SDDIF S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" S S=$E(S,1,I)_Y_$E(S,I+2,999),SS=SS-1 Q:SS'>0
S ^SC(SDECSCD,"ST",SD\1,1)=S
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCREATEAPPT44 7126 printed Dec 13, 2024@02:56:24 Page 2
SDESCREATEAPPT44 ;ALB/BLB,DJS,BLB,TJB - SDES CREATE APPOINTMENT ;Jun 17, 2024
+1 ;;5.3;Scheduling;**814,823,827,851,877,881**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
+6 ; create appt in file 44. Called from wrapper level SDESCRTAPPTWRAP. See SDESCRTAPPTWRAP for required inputs.
+7 ;
+8 ;
VALIDATE(ERRORS,ARY44) ;
+1 ;
+2 NEW HAS44APPT,SDDA
+3 ;
+4 ; clinic IEN
+5 SET ARY44("CLINICIEN")=$GET(ARY44("CLINICIEN"),"")
+6 IF ARY44("CLINICIEN")=""
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT
+7 IF '$DATA(^SC(+ARY44("CLINICIEN"),0))
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT
+8 IF $$INACTIVE^SDEC32(+ARY44("CLINICIEN"))
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT
+9 ;
+10 ; patient DFN
+11 SET ARY44("DFN")=$GET(ARY44("DFN"),"")
+12 IF ARY44("DFN")=""
DO ERRLOG^SDESJSON(.ERRORS,1)
QUIT
+13 IF ARY44("DFN")'=""
IF '$DATA(^DPT(+ARY44("DFN"),0))
DO ERRLOG^SDESJSON(.ERRORS,2)
QUIT
+14 ;
+15 ; desired date/time of appt
+16 SET ARY44("SDAPPTSTARTDTTM")=$GET(ARY44("SDAPPTSTARTDTTM"),"")
+17 IF ARY44("SDAPPTSTARTDTTM")=""
DO ERRLOG^SDESJSON(.ERRORS,57)
QUIT
+18 ; vse-2397 clinic time zone
SET ARY44("SDAPPTSTARTDTTM")=$$ISOTFM^SDAMUTDT(ARY44("SDAPPTSTARTDTTM"),ARY44("CLINICIEN"))
+19 IF ARY44("SDAPPTSTARTDTTM")=-1
SET ARY44("SDAPPTSTARTDTTM")=""
DO ERRLOG^SDESJSON(.ERRORS,58)
QUIT
+20 ;I ARY44("SDAPPTSTARTDTTM")<DT D ERRLOG^SDESJSON(.ERRORS,59) Q ;Only validate on Create, Allow Appointments made in the Past
+21 ;
+22 ; appointment Length in Minutes
+23 SET ARY44("SDAPPTLENGTH")=$GET(ARY44("SDAPPTLENGTH"),"")
+24 IF ARY44("SDAPPTLENGTH")=""
DO ERRLOG^SDESJSON(.ERRORS,115)
QUIT
+25 IF ARY44("SDAPPTLENGTH")'=""
IF ((+ARY44("SDAPPTLENGTH")<5)!(+ARY44("SDAPPTLENGTH")>240))
DO ERRLOG^SDESJSON(.ERRORS,116)
QUIT
+26 ;
+27 ; appointment Reason
+28 SET ARY44("SDAPPTREASON")=$GET(ARY44("SDAPPTREASON"),"")
+29 SET ARY44("SDAPPTREASON")=$TRANSLATE($GET(ARY44("SDAPPTREASON")),"^"," ")
+30 ;
+31 ; overbook
+32 SET ARY44("SDOVERBOOK")=$GET(ARY44("SDOVERBOOK"),"")
+33 IF ARY44("SDOVERBOOK")'=""
Begin DoDot:1
+34 IF ARY44("SDOVERBOOK")'=1
IF ARY44("SDOVERBOOK")'=0
DO ERRLOG^SDESJSON(.ERRORS,112)
QUIT
End DoDot:1
+35 ;
+36 ; patient Eligibility
+37 SET ARY44("SDPATELIG")=$GET(ARY44("SDPATELIG"),"")
+38 IF ARY44("SDPATELIG")'=""
IF '$DATA(^DIC(8,+ARY44("SDPATELIG"),0))
DO ERRLOG^SDESJSON(.ERRORS,143)
QUIT
+39 ;
+40 ; check for existing appointment in clinic for same patient/date/time
+41 SET HAS44APPT=$$APPTIN44EXISTS(ARY44("DFN"),ARY44("CLINICIEN"),ARY44("SDAPPTSTARTDTTM"))
+42 IF HAS44APPT
DO ERRLOG^SDESJSON(.ERRORS,175)
QUIT
+43 ;
+44 QUIT
APPTIN44EXISTS(DFN,CLINIC,DATE) ;
+1 NEW SUBIEN,FOUND
+2 SET FOUND=0
+3 SET SUBIEN=0
FOR
SET SUBIEN=$ORDER(^SC(CLINIC,"S",DATE,1,SUBIEN))
if 'SUBIEN!($GET(FOUND)=1)
QUIT
Begin DoDot:1
+4 ;cancelled
IF $$GET1^DIQ(44.003,SUBIEN_","_DATE_","_CLINIC_",",310)="CANCELLED"
QUIT
+5 ; record exists
IF $$GET1^DIQ(44.003,SUBIEN_","_DATE_","_CLINIC_",",.01,"I")=DFN
SET FOUND=1
QUIT
End DoDot:1
+6 IF $GET(FOUND)=1
QUIT 1
+7 QUIT 0
+8 ;
CREATE(ARRAY44001FDA,ARRAY44003FDA,NEWIEN44001,IENS44,ARY44) ;
+1 ;
+2 ; only allow one entry in 44.001 for a single date
+3 IF '$DATA(^SC($GET(ARY44("CLINICIEN")),"S",$GET(ARY44("SDAPPTSTARTDTTM"))))
Begin DoDot:1
+4 SET NEWIEN44001(1)=ARY44("SDAPPTSTARTDTTM")
+5 SET ARRAY44001FDA(44.001,"+1,"_$GET(ARY44("CLINICIEN"))_",",.01)=$GET(ARY44("SDAPPTSTARTDTTM"))
End DoDot:1
+6 SET IENS44(1)=ARY44("SDAPPTSTARTDTTM")_","_ARY44("CLINICIEN")_","
+7 SET ARRAY44003FDA(44.003,"+1,"_IENS44(1),.01)=$GET(ARY44("DFN"))
+8 SET ARRAY44003FDA(44.003,"+1,"_IENS44(1),1)=$GET(ARY44("SDAPPTLENGTH"))
+9 SET ARRAY44003FDA(44.003,"+1,"_IENS44(1),3)=$EXTRACT($GET(ARY44("SDAPPTREASON")),1,150)
+10 SET ARRAY44003FDA(44.003,"+1,"_IENS44(1),30)=$GET(ARY44("SDPATELIG"))
+11 SET ARRAY44003FDA(44.003,"+1,"_IENS44(1),9)=$SELECT(+ARY44("SDOVERBOOK"):"O",1:"")
+12 SET ARRAY44003FDA(44.003,"+1,"_IENS44(1),7)=$GET(DUZ)
+13 SET ARRAY44003FDA(44.003,"+1,"_IENS44(1),8)=$$NOW^XLFDT
+14 QUIT
CLEANUP44(ARY44,NEWIEN44,SDREQTYPE) ;
+1 ;add consult link
+2 IF $PIECE(ARY44("SDREQTYPE"),"|",1)="C"
Begin DoDot:1
+3 NEW SDFDA
+4 SET SDFDA(44.003,NEWIEN44_","_ARY44("SDAPPTSTARTDTTM")_","_ARY44("CLINICIEN")_",",688)=$PIECE(SDREQTYPE,"|",2)
+5 DO UPDATE^DIE("","SDFDA")
KILL SDFDA
End DoDot:1
+6 ;
+7 ;make appt event #1
+8 SET SDDA=$$SCIEN^SDECU2($GET(ARY44("DFN")),$GET(ARY44("CLINICIEN")),$GET(ARY44("SDAPPTSTARTDTTM")))
+9 DO MAKE^SDAMEVT($GET(ARY44("DFN")),$GET(ARY44("SDAPPTSTARTDTTM")),$GET(ARY44("CLINICIEN")),SDDA,2)
+10 ;update clinic availability
+11 DO DECREMENTAVAIL1($GET(ARY44("CLINICIEN")),$GET(ARY44("SDAPPTSTARTDTTM")),$GET(ARY44("SDAPPTLENGTH")))
+12 QUIT
+13 ;
DECREMENTAVAIL1(CLINICIEN,APPTSTARTTIME,APPTLENGTH) ;
+1 NEW COUNT,CLINICAPPTLENGTH,NUMOFSLOTSINPLAY
+2 SET CLINICAPPTLENGTH=+$EXTRACT($$GET1^DIQ(44,CLINICIEN,1917,"E"),1,2)
+3 SET NUMOFSLOTSINPLAY=APPTLENGTH/CLINICAPPTLENGTH
+4 FOR COUNT=1:1:NUMOFSLOTSINPLAY
Begin DoDot:1
+5 IF COUNT>1
Begin DoDot:2
+6 SET APPTSTARTTIME=$$FMADD^XLFDT(APPTSTARTTIME,,,CLINICAPPTLENGTH)
End DoDot:2
+7 DO DECREMENTAVAIL2(CLINICIEN,APPTSTARTTIME,APPTLENGTH)
End DoDot:1
+8 QUIT
+9 ;
DECREMENTAVAIL2(CLINICIEN,APPTSTARTTIME,APPTLENGTH) ;decrement availability by one when creating appointment
+1 NEW SLOTINCREMENT,SLOTSTATUSSTRING,CURRENTSCHEDULE,NEWSCHEDULE,TIMECLINICOPENS,SLOTLENGTH,NEWAVAILABILITY,SPECIALCHARACTER,AVAILABILITYFDA,CENTEROFSLOT,CHARMULTIPLIER,MAXDAYSINFUTURE
+2 ;
+3 SET CURRENTSCHEDULE=$$GET1^DIQ(44.005,$PIECE(APPTSTARTTIME,".")_","_CLINICIEN_",",1)
+4 SET TIMECLINICOPENS=$SELECT($LENGTH($$GET1^DIQ(44,CLINICIEN,1914,"I")):$$GET1^DIQ(44,CLINICIEN,1914,"I"),1:8)-1/100
+5 SET SLOTLENGTH=$SELECT($$GET1^DIQ(44,CLINICIEN,1917,"I"):$$GET1^DIQ(44,CLINICIEN,1917,"I"),1:4)
+6 SET SLOTINCREMENT=$SELECT('$$GET1^DIQ(44,CLINICIEN,1917,"I"):4,$$GET1^DIQ(44,CLINICIEN,1917,"I")<3:4,$$GET1^DIQ(44,CLINICIEN,1917,"I"):$$GET1^DIQ(44,CLINICIEN,1917,"I"),1:4)
+7 SET CHARMULTIPLIER=$SELECT(SLOTLENGTH<3:8/SLOTLENGTH,1:2)
+8 SET NEWAVAILABILITY=APPTSTARTTIME#1-TIMECLINICOPENS*100
+9 SET CENTEROFSLOT=NEWAVAILABILITY#1*SLOTINCREMENT\.6+(NEWAVAILABILITY\1*SLOTINCREMENT)*2
+10 SET MAXDAYSINFUTURE=$$GET1^DIQ(44,CLINICIEN,2002,"I")
+11 SET SLOTSTATUSSTRING="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
+12 ;
+13 IF $PIECE(APPTSTARTTIME,".")>$$FMADD^XLFDT(DT,MAXDAYSINFUTURE)
DO ERRLOG^SDESJSON(.ERRORS,491)
QUIT
+14 ;
+15 IF '$DATA(^SC(CLINICIEN,"ST",$PIECE(APPTSTARTTIME,"."),1))
Begin DoDot:1
+16 DO ASSEMBLE^SDESCLINDAILYSCH(.ERRORS,CLINICIEN,$PIECE(APPTSTARTTIME,"."),$$GET1^DIQ(44,CLINICIEN,1917,"I"),TIMECLINICOPENS)
End DoDot:1
+17 ;
+18 IF $DATA(^SC(CLINICIEN,"ST",$PIECE(APPTSTARTTIME,"."),"CAN"))!(CURRENTSCHEDULE["CAN")
DO ERRLOG^SDESJSON(.ERRORS,492)
+19 ;
+20 FOR SPECIALCHARACTER=CENTEROFSLOT:CHARMULTIPLIER
if $LENGTH($GET(NEWSCHEDULE))!($GET(NEWAVAILABILITY)="")
QUIT
Begin DoDot:1
+21 SET NEWAVAILABILITY=$EXTRACT(SLOTSTATUSSTRING,$FIND(SLOTSTATUSSTRING,$EXTRACT(CURRENTSCHEDULE,SPECIALCHARACTER+1))-2)
+22 SET NEWSCHEDULE=$EXTRACT(CURRENTSCHEDULE,1,SPECIALCHARACTER)_NEWAVAILABILITY_$EXTRACT(CURRENTSCHEDULE,SPECIALCHARACTER+2,999)
End DoDot:1
+23 ;
+24 SET AVAILABILITYFDA(44.005,$PIECE(APPTSTARTTIME,".")_","_CLINICIEN_",",1)=NEWSCHEDULE
+25 DO FILE^DIE(,"AVAILABILITYFDA")
KILL AVAILABILITYFDA
+26 QUIT
+27 ;
AVUPDT(SDECSCD,SDECSTART,SDECLEN) ;
+1 NEW HSI,I,S,SB,SD,SDDIF,SI,SL,SS,ST,STARTDAY,STR,X,Y
+2 SET (SD,S)=SDECSTART
+3 SET I=SDECSCD
+4 if '$DATA(^SC(I,"ST",SD\1,1))
QUIT
+5 SET SL=^SC(I,"SL")
SET X=$PIECE(SL,U,3)
SET STARTDAY=$SELECT($LENGTH(X):X,1:8)
SET SB=STARTDAY-1/100
SET X=$PIECE(SL,U,6)
SET HSI=$SELECT(X:X,1:4)
SET SI=$SELECT(X="":4,X<3:4,X:X,1:4)
SET STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
SET SDDIF=$SELECT(HSI<3:8/HSI,1:2)
+6 SET SL=SDECLEN
+7 SET S=^SC(I,"ST",SD\1,1)
SET Y=SD#1-SB*100
SET ST=Y#1*SI\.6+(Y\1*SI)
SET SS=SL*HSI/60
+8 IF Y'<1
FOR I=ST+ST:SDDIF
SET Y=$EXTRACT(STR,$FIND(STR,$EXTRACT(S,I+1)))
if Y=""
QUIT
SET S=$EXTRACT(S,1,I)_Y_$EXTRACT(S,I+2,999)
SET SS=SS-1
if SS'>0
QUIT
+9 SET ^SC(SDECSCD,"ST",SD\1,1)=S
+10 QUIT
+11 ;
