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.
  1. SDESGETAVAILSC ;ALB/BWF - VISTA SCHEDULING AVAILABILITY BY STOP CODE ;Mar 11, 2023
  1. ;;5.3;Scheduling;**842**;Aug 13, 1993;Build 17
  1. ;;Per VHA Directive 6402, this routine should not be modified;
  1. ;
  1. Q
  1. SCAVAIL(RESULT,EASAUDITID,STOPCODE,CREDSTOPCODES,STRTDATE,ENDDATE,NUMBERRET,SDEASTRKNG) ;
  1. N CLINLIST,ERRORS,CLINAVAIL,STARTDT,ENDDT
  1. S CLINLIST=$NA(^TMP("SDESGETAVAILSC",$J,"CLINLIST")) K @CLINLIST
  1. S STOPCODE=$G(STOPCODE),STRTDATE=$G(STRTDATE),ENDDATE=$G(ENDDATE),NUMBERRET=$G(NUMBERRET,10),SDEASTRKNG=$G(SDEASTRKNG)
  1. S STARTDT=$$VALDATE2^SDESVALUTIL(.ERRORS,STRTDATE,,9,11)
  1. I '$D(ERRORS),STARTDT<DT D ERRLOG^SDESJSON(.ERRORS,243)
  1. S ENDDT=$$VALDATE2^SDESVALUTIL(.ERRORS,ENDDATE,,10,12)
  1. I '$D(ERRORS),ENDDT<STARTDT D ERRLOG^SDESJSON(.ERRORS,13)
  1. D VALPRIMSTOP(.ERRORS,STOPCODE)
  1. I $D(CREDSTOPCODES) D VALCRSTOP(.ERRORS,.CREDSTOPCODES)
  1. D VALNUM(.ERRORS,NUMBERRET)
  1. D VALIDATEEAS^SDESINPUTVALUTL(.ERRORS,SDEASTRKNG)
  1. I $D(ERRORS) D Q
  1. .S ERRORS("Availability",1)=""
  1. .D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
  1. D MATCHCLIN(.CLINLIST,STOPCODE,.CREDSTOPCODES)
  1. D GETAVAIL(.CLINAVAIL,.CLINLIST,STARTDT,ENDDT,NUMBERRET)
  1. I '$D(CLINAVAIL) S CLINAVAIL("Availability",1)=""
  1. D BUILDJSON^SDESBUILDJSON(.RESULT,.CLINAVAIL)
  1. K @CLINLIST
  1. Q
  1. GETAVAIL(RETURN,CLINLIST,START,END,NUMBER) ;
  1. N CLINNAME,RESOURCEIEN,SDERR,CLIN,GLOB,CNT,DONE,APPTDAT,APPTSTRT,APPTEND,AVAIL,SLOTS,DONE,SDI,SDECEND,BADATE,LOOP
  1. S (CNT,DONE)=0
  1. S CLIN="" F S CLIN=$O(@CLINLIST@(CLIN),-1) Q:'CLIN!(DONE) D
  1. .S GLOB=$NA(^TMP("SDESGETAVAILSC",$J,CLIN)) K @GLOB
  1. .S BADATE=0
  1. .S SDI=$$FMADD^XLFDT(START,-1),SDECEND=END
  1. .F S SDI=$$FMADD^XLFDT(SDI,1) Q:SDI>$P(SDECEND,".",1)!(BADATE>0)!(DONE) D ;
  1. ..I SDI<0 S BADATE=1 Q
  1. ..I ($O(^SC(CLIN,"T",0))="")!($O(^SC(CLIN,"T",0))>SDI) Q
  1. ..I $$GET1^DIQ(44,CLIN_",",1918.5,"I")'="Y",$D(^HOLIDAY("B",SDI)) Q ;do not schedule on holidays
  1. ..Q:$$INACTIVE^SDESUTIL(CLIN,$P(SDI,".",1)) ;don't get availability if clinic inactive on day SDI
  1. ..D RESAB^SDEC57(GLOB,CLIN,SDI,SDI_"."_2359) Q:'$D(^TMP("SDESGETAVAILSC",$J,CLIN))
  1. ..S LOOP=0 F S LOOP=$O(^TMP("SDESGETAVAILSC",$J,CLIN,LOOP)) Q:'LOOP!(DONE) D
  1. ...S APPTDAT=$G(^TMP("SDESGETAVAILSC",$J,CLIN,LOOP))
  1. ...S APPTSTRT=$P(APPTDAT,U,2)
  1. ...S APPTEND=$P(APPTDAT,U,3)
  1. ...S SLOTS=$P(APPTDAT,U,4)
  1. ...Q:SLOTS=0!(SLOTS="")
  1. ...S AVAIL=$P(APPTDAT,U,5)
  1. ...S SLOTS=$S(SLOTS=" ":"",1:SLOTS)
  1. ...S SLOTS=$S(AVAIL=2:"",AVAIL=3:"X",1:SLOTS)
  1. ...I "jklmnopqrstuvwxyz"[SLOTS S SLOTS=9+($F("jklmnopqrstuvwxyz",SLOTS)-1)
  1. ...Q:'SLOTS
  1. ...S CNT=CNT+1
  1. ...I NUMBER-SLOTS<0 S SLOTS=NUMBER
  1. ...S NUMBER=$G(NUMBER)-SLOTS
  1. ...S RETURN("Availability",CNT,"ClinicID")=CLIN
  1. ...S RETURN("Availability",CNT,"ClinicName")=$$GET1^DIQ(44,CLIN,.01,"E")
  1. ...S RETURN("Availability",CNT,"AppointmentStart")=$$FMTISO^SDAMUTDT($P(APPTDAT,U,2))
  1. ...S RETURN("Availability",CNT,"AppointmentEnd")=$$FMTISO^SDAMUTDT($P(APPTDAT,U,3))
  1. ...S RETURN("Availability",CNT,"AvailableSlots")=SLOTS
  1. ...I NUMBER<1 S DONE=1
  1. ..K @GLOB
  1. Q
  1. MATCHCLIN(CLINLIST,STCODE,CRSTCODES) ;
  1. N STOPIEN,CREDSTOPIEN,CREDSTOPIENS,CRSTLOOP,CRSTOPIEN,CLINIEN
  1. S STOPIEN=$$AMISTOSTOPCODE^SDESUTIL(STCODE)
  1. S CRSTLOOP=0 F S CRSTLOOP=$O(CRSTCODES(CRSTLOOP)) Q:'CRSTLOOP D
  1. .S CREDSTOPIEN=$$AMISTOSTOPCODE^SDESUTIL(CRSTLOOP)
  1. .I CREDSTOPIEN S CREDSTOPIENS(CREDSTOPIEN)=""
  1. S CLINIEN=0 F S CLINIEN=$O(^SC("AST",STOPIEN,CLINIEN)) Q:'CLINIEN D
  1. .I $D(CREDSTOPIENS) D Q
  1. ..S CRSTOPIEN=0 F S CRSTOPIEN=$O(CREDSTOPIENS(CRSTOPIEN)) Q:'CRSTOPIEN D
  1. ...I $D(^SC("ACST",CRSTOPIEN,CLINIEN)) S @CLINLIST@(CLINIEN)="" Q
  1. .S @CLINLIST@(CLINIEN)=""
  1. Q
  1. VALPRIMSTOP(ERRORS,CODE) ;
  1. I 'CODE D ERRLOG^SDESJSON(.ERRORS,272) Q
  1. I '$D(^DIC(40.7,"C",CODE)) D ERRLOG^SDESJSON(.ERRORS,270)
  1. Q
  1. VALCRSTOP(ERRORS,CODES) ;
  1. N X,DONE
  1. S (X,DONE)=0 F S X=$O(CODES(X)) Q:X=""!(DONE) D
  1. .I '$D(^DIC(40.7,"C",X)) D ERRLOG^SDESJSON(.ERRORS,271) S DONE=1
  1. Q
  1. VALNUM(ERRORS,NUMBERRET) ;
  1. I $G(NUMBERRET)<1!($G(NUMBERRET)>50) D ERRLOG^SDESJSON(.ERRORS,382)
  1. Q