- SDESCLINDAILYSCH ;ALB/BLB - SDES GET CLINIC DAILY SCHEDULE ;Jan 9, 2023@18:47
- ;;5.3;Scheduling;**836,860**;Aug 13, 1993;Build 12
- ;;Per VHA Directive 6402, this routine should not be modified
- ;
- Q
- ;
- GETSCHEDULE(JSONRETURN,CLINICIEN,DATE) ;
- N ERRORS,RETURN,SCHEDULE,DOW,SUB
- ;
- ; validate
- D VALIDATEDATE(.ERRORS,.DATE,$G(CLINICIEN))
- D VALIDATECLINIC(.ERRORS,$G(CLINICIEN))
- I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
- ;
- S DOW=$$UP^XLFSTR($$DOW^XLFDT(DATE))
- S SUB=$$SUB(.SUB,DOW)
- S DAYSCHEDULE=$$GETDAYSCHEDULE(CLINICIEN,SUB,DATE)
- I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
- ;
- ; build slots
- D BUILD(.SCHEDULE,DAYSCHEDULE,CLINICIEN,SUB,DATE)
- I '$D(SCHEDULE) S SCHEDULE("ClinicSlot",1)=""
- M RETURN=SCHEDULE
- D BUILDJSON(.JSONRETURN,.RETURN)
- Q
- ;
- BUILD(SCHEDULE,DAYSCHEDULE,CLINICIEN,SUB,DATE) ;
- N SLOTIEN,CLINICSTART,APPTLENGTH,INCREMENT,SLOTS,STARTTIME,COUNT,NEWSLOTS,TIME,STRING
- ;
- S STRING="123456789jklmnopqrstuvwxyz"
- S CLINICSTART=$$GET1^DIQ(44,CLINICIEN,1914,"I")
- S APPTLENGTH=$$GET1^DIQ(44,CLINICIEN,1912,"I")
- S INCREMENT=$$GET1^DIQ(44,CLINICIEN,1917,"I")
- ;
- I '$D(^SC(CLINICIEN,"ST",DATE,1)) D
- .D ASSEMBLE(.ERRORS,CLINICIEN,DATE,INCREMENT,CLINICSTART)
- ;
- D ARRAY^SDECUTL2(.SLOTS,DAYSCHEDULE,DATE,APPTLENGTH,CLINICSTART,INCREMENT)
- D NEWSLOTS(.NEWSLOTS,DATE,.SLOTS)
- ;
- S STARTTIME="",COUNT=0
- F S STARTTIME=$O(NEWSLOTS(DATE,STARTTIME)) Q:STARTTIME="" D
- .S COUNT=COUNT+1
- .S TIME=STARTTIME
- .;
- .I $$GET1^DIQ(44,CLINICIEN,1912,"I")#60'=0 D
- ..I $L($G(TIME))=3 S TIME="0"_TIME
- ..I $L($G(TIME))=2 S TIME="00"_TIME
- ..I $L($G(TIME))=1 S TIME="000"_TIME
- .;
- .I $$GET1^DIQ(44,CLINICIEN,1912,"I")#60=0 D
- ..I $L(TIME)=1 D
- ...S TIME="0"_TIME_"00"
- ..;
- ..I $L(TIME)=2 D
- ...S TIME=TIME_"00"
- .;
- .S SCHEDULE("ClinicSlot",COUNT,"Date")=$$FMTISO^SDAMUTDT(DATE)
- .S SCHEDULE("ClinicSlot",COUNT,"StartTime")=TIME
- .I $G(NEWSLOTS(DATE,STARTTIME))'?.A,+$G(NEWSLOTS(DATE,STARTTIME))=0 S SCHEDULE("ClinicSlot",COUNT,"OpenSlots")=0 Q
- .S SCHEDULE("ClinicSlot",COUNT,"OpenSlots")=$S($G(NEWSLOTS(DATE,STARTTIME))'?.N:$F(STRING,$G(NEWSLOTS(DATE,STARTTIME)))-1,1:+$G(NEWSLOTS(DATE,STARTTIME)))
- Q
- ;
- NEWSLOTS(NEWSLOT,CDATE,SLOTS) ;
- N SLOT,VALUE,NEWTIMESLOT
- S SLOT="" F S SLOT=$O(SLOTS(CDATE,SLOT)) Q:SLOT="" D
- .S NEWTIMESLOT=+SLOT Q:SLOT=""
- .S VALUE=$G(SLOTS(CDATE,SLOT))
- .S NEWSLOT(CDATE,NEWTIMESLOT)=VALUE
- Q
- ;
- ASSEMBLE(ERRORS,CLINICIEN,DATE,INCREMENT,CLINSTART) ;
- N DOW,MASTERPATTERN,MPATTERNSLOTS,X,Y,FILENOFDA,FDAIEN,FERR,FILENO
- S X=DATE
- D DOW^SDM0 S DOW=Y
- S MASTERPATTERN=+$O(^SC(CLINICIEN,"T"_DOW,DATE))
- S FILENO=$SELECT(DOW=0:44.06,DOW=1:44.07,DOW=2:44.08,DOW=3:44.09,DOW=4:44.008,DOW=5:44.009,DOW=6:44.0001,1:"")
- S MPATTERNSLOTS=$$GET1^DIQ(FILENO,MASTERPATTERN_","_CLINICIEN_",",1)
- S FDA(44.005,"+1,"_CLINICIEN_",",.01)=DATE
- S FDA(44.005,"+1,"_CLINICIEN_",",1)=$P("SU^MO^TU^WE^TH^FR^SA",U,DOW+1)_" "_$E(DATE,6,7)_$J("",INCREMENT+INCREMENT-6)_MPATTERNSLOTS
- S FDAIEN(1)=DATE
- D UPDATE^DIE(,"FDA","FDAIEN","FERR") K FDA,FDAIEN
- Q
- ;
- GETDAYSCHEDULE(CLINICIEN,SUB,DATE) ;
- S DAYSCHEDULE=$G(^SC(CLINICIEN,SUB,9999999,1))
- I DAYSCHEDULE["CANCELLED" D ERRLOG^SDESJSON(.ERRORS,248) Q ""
- ;
- I $D(^SC(CLINICIEN,"OST",DATE,1)) D
- .S DAYSCHEDULE=$E($G(^SC(CLINICIEN,"OST",DATE,1)),8,$L($G(^SC(CLINICIEN,"OST",DATE,1))))
- ;
- I DAYSCHEDULE'["[" D ERRLOG^SDESJSON(.ERRORS,249) Q "" ; doesnt meet today
- Q DAYSCHEDULE
- ;
- VALIDATEDATE(ERRORS,DATE,CLINICIEN) ;
- I $G(DATE)="" D ERRLOG^SDESJSON(.ERRORS,45) Q
- S DATE=$$ISOTFM^SDAMUTDT(DATE,CLINICIEN)
- I $G(DATE)=-1 D ERRLOG^SDESJSON(.ERRORS,46) Q
- I $G(DATE)&(DATE<DT) D ERRLOG^SDESJSON(.ERRORS,71)
- Q DATE
- ;
- VALIDATECLINIC(ERRORS,CLINICIEN) ;
- I CLINICIEN="" D ERRLOG^SDESJSON(.ERRORS,18) Q
- I CLINICIEN'="",'$D(^SC(CLINICIEN,0)) D ERRLOG^SDESJSON(.ERRORS,19)
- Q
- ;
- SUB(SUB,DOW) ;
- S SUB="T"_$S(DOW="SUNDAY":0,DOW="MONDAY":1,DOW="TUESDAY":2,DOW="WEDNESDAY":3,DOW="THURSDAY":4,DOW="FRIDAY":5,DOW="SATURDAY":6,1:"")
- Q SUB
- ;
- BUILDJSON(JSONRETURN,RETURN) ;
- N JSONERROR
- D ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERROR")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCLINDAILYSCH 4157 printed Jan 18, 2025@03:57:19 Page 2
- SDESCLINDAILYSCH ;ALB/BLB - SDES GET CLINIC DAILY SCHEDULE ;Jan 9, 2023@18:47
- +1 ;;5.3;Scheduling;**836,860**;Aug 13, 1993;Build 12
- +2 ;;Per VHA Directive 6402, this routine should not be modified
- +3 ;
- +4 QUIT
- +5 ;
- GETSCHEDULE(JSONRETURN,CLINICIEN,DATE) ;
- +1 NEW ERRORS,RETURN,SCHEDULE,DOW,SUB
- +2 ;
- +3 ; validate
- +4 DO VALIDATEDATE(.ERRORS,.DATE,$GET(CLINICIEN))
- +5 DO VALIDATECLINIC(.ERRORS,$GET(CLINICIEN))
- +6 IF $DATA(ERRORS)
- MERGE RETURN=ERRORS
- DO BUILDJSON(.JSONRETURN,.RETURN)
- QUIT
- +7 ;
- +8 SET DOW=$$UP^XLFSTR($$DOW^XLFDT(DATE))
- +9 SET SUB=$$SUB(.SUB,DOW)
- +10 SET DAYSCHEDULE=$$GETDAYSCHEDULE(CLINICIEN,SUB,DATE)
- +11 IF $DATA(ERRORS)
- MERGE RETURN=ERRORS
- DO BUILDJSON(.JSONRETURN,.RETURN)
- QUIT
- +12 ;
- +13 ; build slots
- +14 DO BUILD(.SCHEDULE,DAYSCHEDULE,CLINICIEN,SUB,DATE)
- +15 IF '$DATA(SCHEDULE)
- SET SCHEDULE("ClinicSlot",1)=""
- +16 MERGE RETURN=SCHEDULE
- +17 DO BUILDJSON(.JSONRETURN,.RETURN)
- +18 QUIT
- +19 ;
- BUILD(SCHEDULE,DAYSCHEDULE,CLINICIEN,SUB,DATE) ;
- +1 NEW SLOTIEN,CLINICSTART,APPTLENGTH,INCREMENT,SLOTS,STARTTIME,COUNT,NEWSLOTS,TIME,STRING
- +2 ;
- +3 SET STRING="123456789jklmnopqrstuvwxyz"
- +4 SET CLINICSTART=$$GET1^DIQ(44,CLINICIEN,1914,"I")
- +5 SET APPTLENGTH=$$GET1^DIQ(44,CLINICIEN,1912,"I")
- +6 SET INCREMENT=$$GET1^DIQ(44,CLINICIEN,1917,"I")
- +7 ;
- +8 IF '$DATA(^SC(CLINICIEN,"ST",DATE,1))
- Begin DoDot:1
- +9 DO ASSEMBLE(.ERRORS,CLINICIEN,DATE,INCREMENT,CLINICSTART)
- End DoDot:1
- +10 ;
- +11 DO ARRAY^SDECUTL2(.SLOTS,DAYSCHEDULE,DATE,APPTLENGTH,CLINICSTART,INCREMENT)
- +12 DO NEWSLOTS(.NEWSLOTS,DATE,.SLOTS)
- +13 ;
- +14 SET STARTTIME=""
- SET COUNT=0
- +15 FOR
- SET STARTTIME=$ORDER(NEWSLOTS(DATE,STARTTIME))
- if STARTTIME=""
- QUIT
- Begin DoDot:1
- +16 SET COUNT=COUNT+1
- +17 SET TIME=STARTTIME
- +18 ;
- +19 IF $$GET1^DIQ(44,CLINICIEN,1912,"I")#60'=0
- Begin DoDot:2
- +20 IF $LENGTH($GET(TIME))=3
- SET TIME="0"_TIME
- +21 IF $LENGTH($GET(TIME))=2
- SET TIME="00"_TIME
- +22 IF $LENGTH($GET(TIME))=1
- SET TIME="000"_TIME
- End DoDot:2
- +23 ;
- +24 IF $$GET1^DIQ(44,CLINICIEN,1912,"I")#60=0
- Begin DoDot:2
- +25 IF $LENGTH(TIME)=1
- Begin DoDot:3
- +26 SET TIME="0"_TIME_"00"
- End DoDot:3
- +27 ;
- +28 IF $LENGTH(TIME)=2
- Begin DoDot:3
- +29 SET TIME=TIME_"00"
- End DoDot:3
- End DoDot:2
- +30 ;
- +31 SET SCHEDULE("ClinicSlot",COUNT,"Date")=$$FMTISO^SDAMUTDT(DATE)
- +32 SET SCHEDULE("ClinicSlot",COUNT,"StartTime")=TIME
- +33 IF $GET(NEWSLOTS(DATE,STARTTIME))'?.A
- IF +$GET(NEWSLOTS(DATE,STARTTIME))=0
- SET SCHEDULE("ClinicSlot",COUNT,"OpenSlots")=0
- QUIT
- +34 SET SCHEDULE("ClinicSlot",COUNT,"OpenSlots")=$SELECT($GET(NEWSLOTS(DATE,STARTTIME))'?.N:$FIND(STRING,$GET(NEWSLOTS(DATE,STARTTIME)))-1,1:+$GET(NEWSLOTS(DATE,STARTTIME)))
- End DoDot:1
- +35 QUIT
- +36 ;
- NEWSLOTS(NEWSLOT,CDATE,SLOTS) ;
- +1 NEW SLOT,VALUE,NEWTIMESLOT
- +2 SET SLOT=""
- FOR
- SET SLOT=$ORDER(SLOTS(CDATE,SLOT))
- if SLOT=""
- QUIT
- Begin DoDot:1
- +3 SET NEWTIMESLOT=+SLOT
- if SLOT=""
- QUIT
- +4 SET VALUE=$GET(SLOTS(CDATE,SLOT))
- +5 SET NEWSLOT(CDATE,NEWTIMESLOT)=VALUE
- End DoDot:1
- +6 QUIT
- +7 ;
- ASSEMBLE(ERRORS,CLINICIEN,DATE,INCREMENT,CLINSTART) ;
- +1 NEW DOW,MASTERPATTERN,MPATTERNSLOTS,X,Y,FILENOFDA,FDAIEN,FERR,FILENO
- +2 SET X=DATE
- +3 DO DOW^SDM0
- SET DOW=Y
- +4 SET MASTERPATTERN=+$ORDER(^SC(CLINICIEN,"T"_DOW,DATE))
- +5 SET FILENO=$SELECT(DOW=0:44.06,DOW=1:44.07,DOW=2:44.08,DOW=3:44.09,DOW=4:44.008,DOW=5:44.009,DOW=6:44.0001,1:"")
- +6 SET MPATTERNSLOTS=$$GET1^DIQ(FILENO,MASTERPATTERN_","_CLINICIEN_",",1)
- +7 SET FDA(44.005,"+1,"_CLINICIEN_",",.01)=DATE
- +8 SET FDA(44.005,"+1,"_CLINICIEN_",",1)=$PIECE("SU^MO^TU^WE^TH^FR^SA",U,DOW+1)_" "_$EXTRACT(DATE,6,7)_$JUSTIFY("",INCREMENT+INCREMENT-6)_MPATTERNSLOTS
- +9 SET FDAIEN(1)=DATE
- +10 DO UPDATE^DIE(,"FDA","FDAIEN","FERR")
- KILL FDA,FDAIEN
- +11 QUIT
- +12 ;
- GETDAYSCHEDULE(CLINICIEN,SUB,DATE) ;
- +1 SET DAYSCHEDULE=$GET(^SC(CLINICIEN,SUB,9999999,1))
- +2 IF DAYSCHEDULE["CANCELLED"
- DO ERRLOG^SDESJSON(.ERRORS,248)
- QUIT ""
- +3 ;
- +4 IF $DATA(^SC(CLINICIEN,"OST",DATE,1))
- Begin DoDot:1
- +5 SET DAYSCHEDULE=$EXTRACT($GET(^SC(CLINICIEN,"OST",DATE,1)),8,$LENGTH($GET(^SC(CLINICIEN,"OST",DATE,1))))
- End DoDot:1
- +6 ;
- +7 ; doesnt meet today
- IF DAYSCHEDULE'["["
- DO ERRLOG^SDESJSON(.ERRORS,249)
- QUIT ""
- +8 QUIT DAYSCHEDULE
- +9 ;
- VALIDATEDATE(ERRORS,DATE,CLINICIEN) ;
- +1 IF $GET(DATE)=""
- DO ERRLOG^SDESJSON(.ERRORS,45)
- QUIT
- +2 SET DATE=$$ISOTFM^SDAMUTDT(DATE,CLINICIEN)
- +3 IF $GET(DATE)=-1
- DO ERRLOG^SDESJSON(.ERRORS,46)
- QUIT
- +4 IF $GET(DATE)&(DATE<DT)
- DO ERRLOG^SDESJSON(.ERRORS,71)
- +5 QUIT DATE
- +6 ;
- VALIDATECLINIC(ERRORS,CLINICIEN) ;
- +1 IF CLINICIEN=""
- DO ERRLOG^SDESJSON(.ERRORS,18)
- QUIT
- +2 IF CLINICIEN'=""
- IF '$DATA(^SC(CLINICIEN,0))
- DO ERRLOG^SDESJSON(.ERRORS,19)
- +3 QUIT
- +4 ;
- SUB(SUB,DOW) ;
- +1 SET SUB="T"_$SELECT(DOW="SUNDAY":0,DOW="MONDAY":1,DOW="TUESDAY":2,DOW="WEDNESDAY":3,DOW="THURSDAY":4,DOW="FRIDAY":5,DOW="SATURDAY":6,1:"")
- +2 QUIT SUB
- +3 ;
- BUILDJSON(JSONRETURN,RETURN) ;
- +1 NEW JSONERROR
- +2 DO ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERROR")
- +3 QUIT
- +4 ;