Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDESGETAVAILSC

SDESGETAVAILSC.m

Go to the documentation of this file.
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