- 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 Jan 18, 2025@03:57:34 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 ;