- SDESGETAVAILSC ;ALB/BWF - VISTA SCHEDULING AVAILABILITY BY STOP CODE ;Mar 11, 2023
- ;;5.3;Scheduling;**842**;Aug 13, 1993;Build 17
- ;;Per VHA Directive 6402, this routine should not be modified;
- ;
- Q
- SCAVAIL(RESULT,EASAUDITID,STOPCODE,CREDSTOPCODES,STRTDATE,ENDDATE,NUMBERRET,SDEASTRKNG) ;
- N CLINLIST,ERRORS,CLINAVAIL,STARTDT,ENDDT
- S CLINLIST=$NA(^TMP("SDESGETAVAILSC",$J,"CLINLIST")) K @CLINLIST
- S STOPCODE=$G(STOPCODE),STRTDATE=$G(STRTDATE),ENDDATE=$G(ENDDATE),NUMBERRET=$G(NUMBERRET,10),SDEASTRKNG=$G(SDEASTRKNG)
- S STARTDT=$$VALDATE2^SDESVALUTIL(.ERRORS,STRTDATE,,9,11)
- I '$D(ERRORS),STARTDT<DT D ERRLOG^SDESJSON(.ERRORS,243)
- S ENDDT=$$VALDATE2^SDESVALUTIL(.ERRORS,ENDDATE,,10,12)
- I '$D(ERRORS),ENDDT<STARTDT D ERRLOG^SDESJSON(.ERRORS,13)
- D VALPRIMSTOP(.ERRORS,STOPCODE)
- I $D(CREDSTOPCODES) D VALCRSTOP(.ERRORS,.CREDSTOPCODES)
- D VALNUM(.ERRORS,NUMBERRET)
- D VALIDATEEAS^SDESINPUTVALUTL(.ERRORS,SDEASTRKNG)
- I $D(ERRORS) D Q
- .S ERRORS("Availability",1)=""
- .D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
- D MATCHCLIN(.CLINLIST,STOPCODE,.CREDSTOPCODES)
- D GETAVAIL(.CLINAVAIL,.CLINLIST,STARTDT,ENDDT,NUMBERRET)
- I '$D(CLINAVAIL) S CLINAVAIL("Availability",1)=""
- D BUILDJSON^SDESBUILDJSON(.RESULT,.CLINAVAIL)
- K @CLINLIST
- Q
- GETAVAIL(RETURN,CLINLIST,START,END,NUMBER) ;
- N CLINNAME,RESOURCEIEN,SDERR,CLIN,GLOB,CNT,DONE,APPTDAT,APPTSTRT,APPTEND,AVAIL,SLOTS,DONE,SDI,SDECEND,BADATE,LOOP
- S (CNT,DONE)=0
- S CLIN="" F S CLIN=$O(@CLINLIST@(CLIN),-1) Q:'CLIN!(DONE) D
- .S GLOB=$NA(^TMP("SDESGETAVAILSC",$J,CLIN)) K @GLOB
- .S BADATE=0
- .S SDI=$$FMADD^XLFDT(START,-1),SDECEND=END
- .F S SDI=$$FMADD^XLFDT(SDI,1) Q:SDI>$P(SDECEND,".",1)!(BADATE>0)!(DONE) D ;
- ..I SDI<0 S BADATE=1 Q
- ..I ($O(^SC(CLIN,"T",0))="")!($O(^SC(CLIN,"T",0))>SDI) Q
- ..I $$GET1^DIQ(44,CLIN_",",1918.5,"I")'="Y",$D(^HOLIDAY("B",SDI)) Q ;do not schedule on holidays
- ..Q:$$INACTIVE^SDESUTIL(CLIN,$P(SDI,".",1)) ;don't get availability if clinic inactive on day SDI
- ..D RESAB^SDEC57(GLOB,CLIN,SDI,SDI_"."_2359) Q:'$D(^TMP("SDESGETAVAILSC",$J,CLIN))
- ..S LOOP=0 F S LOOP=$O(^TMP("SDESGETAVAILSC",$J,CLIN,LOOP)) Q:'LOOP!(DONE) D
- ...S APPTDAT=$G(^TMP("SDESGETAVAILSC",$J,CLIN,LOOP))
- ...S APPTSTRT=$P(APPTDAT,U,2)
- ...S APPTEND=$P(APPTDAT,U,3)
- ...S SLOTS=$P(APPTDAT,U,4)
- ...Q:SLOTS=0!(SLOTS="")
- ...S AVAIL=$P(APPTDAT,U,5)
- ...S SLOTS=$S(SLOTS=" ":"",1:SLOTS)
- ...S SLOTS=$S(AVAIL=2:"",AVAIL=3:"X",1:SLOTS)
- ...I "jklmnopqrstuvwxyz"[SLOTS S SLOTS=9+($F("jklmnopqrstuvwxyz",SLOTS)-1)
- ...Q:'SLOTS
- ...S CNT=CNT+1
- ...I NUMBER-SLOTS<0 S SLOTS=NUMBER
- ...S NUMBER=$G(NUMBER)-SLOTS
- ...S RETURN("Availability",CNT,"ClinicID")=CLIN
- ...S RETURN("Availability",CNT,"ClinicName")=$$GET1^DIQ(44,CLIN,.01,"E")
- ...S RETURN("Availability",CNT,"AppointmentStart")=$$FMTISO^SDAMUTDT($P(APPTDAT,U,2))
- ...S RETURN("Availability",CNT,"AppointmentEnd")=$$FMTISO^SDAMUTDT($P(APPTDAT,U,3))
- ...S RETURN("Availability",CNT,"AvailableSlots")=SLOTS
- ...I NUMBER<1 S DONE=1
- ..K @GLOB
- Q
- MATCHCLIN(CLINLIST,STCODE,CRSTCODES) ;
- N STOPIEN,CREDSTOPIEN,CREDSTOPIENS,CRSTLOOP,CRSTOPIEN,CLINIEN
- S STOPIEN=$$AMISTOSTOPCODE^SDESUTIL(STCODE)
- S CRSTLOOP=0 F S CRSTLOOP=$O(CRSTCODES(CRSTLOOP)) Q:'CRSTLOOP D
- .S CREDSTOPIEN=$$AMISTOSTOPCODE^SDESUTIL(CRSTLOOP)
- .I CREDSTOPIEN S CREDSTOPIENS(CREDSTOPIEN)=""
- S CLINIEN=0 F S CLINIEN=$O(^SC("AST",STOPIEN,CLINIEN)) Q:'CLINIEN D
- .I $D(CREDSTOPIENS) D Q
- ..S CRSTOPIEN=0 F S CRSTOPIEN=$O(CREDSTOPIENS(CRSTOPIEN)) Q:'CRSTOPIEN D
- ...I $D(^SC("ACST",CRSTOPIEN,CLINIEN)) S @CLINLIST@(CLINIEN)="" Q
- .S @CLINLIST@(CLINIEN)=""
- Q
- VALPRIMSTOP(ERRORS,CODE) ;
- I 'CODE D ERRLOG^SDESJSON(.ERRORS,272) Q
- I '$D(^DIC(40.7,"C",CODE)) D ERRLOG^SDESJSON(.ERRORS,270)
- Q
- VALCRSTOP(ERRORS,CODES) ;
- N X,DONE
- S (X,DONE)=0 F S X=$O(CODES(X)) Q:X=""!(DONE) D
- .I '$D(^DIC(40.7,"C",X)) D ERRLOG^SDESJSON(.ERRORS,271) S DONE=1
- Q
- VALNUM(ERRORS,NUMBERRET) ;
- I $G(NUMBERRET)<1!($G(NUMBERRET)>50) D ERRLOG^SDESJSON(.ERRORS,382)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESGETAVAILSC 4006 printed Jan 18, 2025@03:57:57 Page 2
- SDESGETAVAILSC ;ALB/BWF - VISTA SCHEDULING AVAILABILITY BY STOP CODE ;Mar 11, 2023
- +1 ;;5.3;Scheduling;**842**;Aug 13, 1993;Build 17
- +2 ;;Per VHA Directive 6402, this routine should not be modified;
- +3 ;
- +4 QUIT
- SCAVAIL(RESULT,EASAUDITID,STOPCODE,CREDSTOPCODES,STRTDATE,ENDDATE,NUMBERRET,SDEASTRKNG) ;
- +1 NEW CLINLIST,ERRORS,CLINAVAIL,STARTDT,ENDDT
- +2 SET CLINLIST=$NAME(^TMP("SDESGETAVAILSC",$JOB,"CLINLIST"))
- KILL @CLINLIST
- +3 SET STOPCODE=$GET(STOPCODE)
- SET STRTDATE=$GET(STRTDATE)
- SET ENDDATE=$GET(ENDDATE)
- SET NUMBERRET=$GET(NUMBERRET,10)
- SET SDEASTRKNG=$GET(SDEASTRKNG)
- +4 SET STARTDT=$$VALDATE2^SDESVALUTIL(.ERRORS,STRTDATE,,9,11)
- +5 IF '$DATA(ERRORS)
- IF STARTDT<DT
- DO ERRLOG^SDESJSON(.ERRORS,243)
- +6 SET ENDDT=$$VALDATE2^SDESVALUTIL(.ERRORS,ENDDATE,,10,12)
- +7 IF '$DATA(ERRORS)
- IF ENDDT<STARTDT
- DO ERRLOG^SDESJSON(.ERRORS,13)
- +8 DO VALPRIMSTOP(.ERRORS,STOPCODE)
- +9 IF $DATA(CREDSTOPCODES)
- DO VALCRSTOP(.ERRORS,.CREDSTOPCODES)
- +10 DO VALNUM(.ERRORS,NUMBERRET)
- +11 DO VALIDATEEAS^SDESINPUTVALUTL(.ERRORS,SDEASTRKNG)
- +12 IF $DATA(ERRORS)
- Begin DoDot:1
- +13 SET ERRORS("Availability",1)=""
- +14 DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
- End DoDot:1
- QUIT
- +15 DO MATCHCLIN(.CLINLIST,STOPCODE,.CREDSTOPCODES)
- +16 DO GETAVAIL(.CLINAVAIL,.CLINLIST,STARTDT,ENDDT,NUMBERRET)
- +17 IF '$DATA(CLINAVAIL)
- SET CLINAVAIL("Availability",1)=""
- +18 DO BUILDJSON^SDESBUILDJSON(.RESULT,.CLINAVAIL)
- +19 KILL @CLINLIST
- +20 QUIT
- GETAVAIL(RETURN,CLINLIST,START,END,NUMBER) ;
- +1 NEW CLINNAME,RESOURCEIEN,SDERR,CLIN,GLOB,CNT,DONE,APPTDAT,APPTSTRT,APPTEND,AVAIL,SLOTS,DONE,SDI,SDECEND,BADATE,LOOP
- +2 SET (CNT,DONE)=0
- +3 SET CLIN=""
- FOR
- SET CLIN=$ORDER(@CLINLIST@(CLIN),-1)
- if 'CLIN!(DONE)
- QUIT
- Begin DoDot:1
- +4 SET GLOB=$NAME(^TMP("SDESGETAVAILSC",$JOB,CLIN))
- KILL @GLOB
- +5 SET BADATE=0
- +6 SET SDI=$$FMADD^XLFDT(START,-1)
- SET SDECEND=END
- +7 ;
- FOR
- SET SDI=$$FMADD^XLFDT(SDI,1)
- if SDI>$PIECE(SDECEND,".",1)!(BADATE>0)!(DONE)
- QUIT
- Begin DoDot:2
- +8 IF SDI<0
- SET BADATE=1
- QUIT
- +9 IF ($ORDER(^SC(CLIN,"T",0))="")!($ORDER(^SC(CLIN,"T",0))>SDI)
- QUIT
- +10 ;do not schedule on holidays
- IF $$GET1^DIQ(44,CLIN_",",1918.5,"I")'="Y"
- IF $DATA(^HOLIDAY("B",SDI))
- QUIT
- +11 ;don't get availability if clinic inactive on day SDI
- if $$INACTIVE^SDESUTIL(CLIN,$PIECE(SDI,".",1))
- QUIT
- +12 DO RESAB^SDEC57(GLOB,CLIN,SDI,SDI_"."_2359)
- if '$DATA(^TMP("SDESGETAVAILSC",$JOB,CLIN))
- QUIT
- +13 SET LOOP=0
- FOR
- SET LOOP=$ORDER(^TMP("SDESGETAVAILSC",$JOB,CLIN,LOOP))
- if 'LOOP!(DONE)
- QUIT
- Begin DoDot:3
- +14 SET APPTDAT=$GET(^TMP("SDESGETAVAILSC",$JOB,CLIN,LOOP))
- +15 SET APPTSTRT=$PIECE(APPTDAT,U,2)
- +16 SET APPTEND=$PIECE(APPTDAT,U,3)
- +17 SET SLOTS=$PIECE(APPTDAT,U,4)
- +18 if SLOTS=0!(SLOTS="")
- QUIT
- +19 SET AVAIL=$PIECE(APPTDAT,U,5)
- +20 SET SLOTS=$SELECT(SLOTS=" ":"",1:SLOTS)
- +21 SET SLOTS=$SELECT(AVAIL=2:"",AVAIL=3:"X",1:SLOTS)
- +22 IF "jklmnopqrstuvwxyz"[SLOTS
- SET SLOTS=9+($FIND("jklmnopqrstuvwxyz",SLOTS)-1)
- +23 if 'SLOTS
- QUIT
- +24 SET CNT=CNT+1
- +25 IF NUMBER-SLOTS<0
- SET SLOTS=NUMBER
- +26 SET NUMBER=$GET(NUMBER)-SLOTS
- +27 SET RETURN("Availability",CNT,"ClinicID")=CLIN
- +28 SET RETURN("Availability",CNT,"ClinicName")=$$GET1^DIQ(44,CLIN,.01,"E")
- +29 SET RETURN("Availability",CNT,"AppointmentStart")=$$FMTISO^SDAMUTDT($PIECE(APPTDAT,U,2))
- +30 SET RETURN("Availability",CNT,"AppointmentEnd")=$$FMTISO^SDAMUTDT($PIECE(APPTDAT,U,3))
- +31 SET RETURN("Availability",CNT,"AvailableSlots")=SLOTS
- +32 IF NUMBER<1
- SET DONE=1
- End DoDot:3
- +33 KILL @GLOB
- End DoDot:2
- End DoDot:1
- +34 QUIT
- MATCHCLIN(CLINLIST,STCODE,CRSTCODES) ;
- +1 NEW STOPIEN,CREDSTOPIEN,CREDSTOPIENS,CRSTLOOP,CRSTOPIEN,CLINIEN
- +2 SET STOPIEN=$$AMISTOSTOPCODE^SDESUTIL(STCODE)
- +3 SET CRSTLOOP=0
- FOR
- SET CRSTLOOP=$ORDER(CRSTCODES(CRSTLOOP))
- if 'CRSTLOOP
- QUIT
- Begin DoDot:1
- +4 SET CREDSTOPIEN=$$AMISTOSTOPCODE^SDESUTIL(CRSTLOOP)
- +5 IF CREDSTOPIEN
- SET CREDSTOPIENS(CREDSTOPIEN)=""
- End DoDot:1
- +6 SET CLINIEN=0
- FOR
- SET CLINIEN=$ORDER(^SC("AST",STOPIEN,CLINIEN))
- if 'CLINIEN
- QUIT
- Begin DoDot:1
- +7 IF $DATA(CREDSTOPIENS)
- Begin DoDot:2
- +8 SET CRSTOPIEN=0
- FOR
- SET CRSTOPIEN=$ORDER(CREDSTOPIENS(CRSTOPIEN))
- if 'CRSTOPIEN
- QUIT
- Begin DoDot:3
- +9 IF $DATA(^SC("ACST",CRSTOPIEN,CLINIEN))
- SET @CLINLIST@(CLINIEN)=""
- QUIT
- End DoDot:3
- End DoDot:2
- QUIT
- +10 SET @CLINLIST@(CLINIEN)=""
- End DoDot:1
- +11 QUIT
- VALPRIMSTOP(ERRORS,CODE) ;
- +1 IF 'CODE
- DO ERRLOG^SDESJSON(.ERRORS,272)
- QUIT
- +2 IF '$DATA(^DIC(40.7,"C",CODE))
- DO ERRLOG^SDESJSON(.ERRORS,270)
- +3 QUIT
- VALCRSTOP(ERRORS,CODES) ;
- +1 NEW X,DONE
- +2 SET (X,DONE)=0
- FOR
- SET X=$ORDER(CODES(X))
- if X=""!(DONE)
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^DIC(40.7,"C",X))
- DO ERRLOG^SDESJSON(.ERRORS,271)
- SET DONE=1
- End DoDot:1
- +4 QUIT
- VALNUM(ERRORS,NUMBERRET) ;
- +1 IF $GET(NUMBERRET)<1!($GET(NUMBERRET)>50)
- DO ERRLOG^SDESJSON(.ERRORS,382)
- +2 QUIT