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

SDES2GETCLINAVL.m

Go to the documentation of this file.
SDES2GETCLINAVL ;ALB/BWF - SDES2 GET CLINIC AVAIL; MAY 24,2024
 ;;5.3;Scheduling;**880**;Aug 13, 1993;Build 5
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 Q
 ; INPUT
 ;
 ; SDCONTEXT - STANDARD SDCONTEXT ARRAY
 ;
 ; SDINPUT("PRIMARY AMIS")=PRIMARY AMIS CODE
 ; SDINPUT("CREDIT AMIS",CREDIT AMIS CODE)=""  - can have multiple credit amis codes
 ; SDINPUT("START DATE")=START DATE
 ; SDINPUT("END DATE")=ENDDATE
 ; SDINPUT("NUMBER RETURNED")=NUMBER OF AVAILABLE SLOTS TO RETURN
 ; SDINPUT("STATION")=STATION NUMBER FOR LOCATION
 ;
CLINICAVAIL(RESULT,SDCONTEXT,SDINPUT) ;
 N CLINLIST,ERRORS,CLINAVAIL,STARTDTFM,ENDDTFM,PRIMARYSTOP,SECSTOPLIST,NUMBERRET
 K ^TMP("SDES2CLINAVAIL",$J)
 S CLINLIST=$NA(^TMP("SDES2CLINAVAIL",$J,"CLINLIST")) K @CLINLIST
 D VALIDATE(.ERRORS,.SDINPUT,.STARTDTFM,.ENDDTFM,.NUMBERRET)
 I $D(ERRORS) D  Q
 .S ERRORS("ClinicAvailability",1)=""
 .D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
 D MATCHCLIN(.CLINLIST,$G(SDINPUT("PRIMARY AMIS")),.SDINPUT)
 D GETAVAIL(.CLINAVAIL,.CLINLIST,STARTDTFM,ENDDTFM,$G(SDINPUT("STATION")),NUMBERRET)
 I '$D(CLINAVAIL) S CLINAVAIL("ClinicAvailability",1)=""
 D BUILDJSON^SDESBUILDJSON(.RESULT,.CLINAVAIL)
 K ^TMP("SDES2CLINAVAIL",$J)
 Q
VALIDATE(ERRORS,SDINPUT,STARTDTFM,ENDDTFM,NUMBERRET) ;
 N ERRORNUM,PRIMAMIS,STARTDT,ENDDT,DATERESULT,INST
 ; Validate Station Number
 I $G(SDINPUT("STATION"))="" D ERRLOG^SDES2JSON(.ERRORS,196)
 I $G(SDINPUT("STATION"))'="" D
 .S INST=$$IEN^XUAF4($G(SDINPUT("STATION")))
 .I 'INST D ERRLOG^SDES2JSON(.ERRORS,197)
 ; Validate Primary Amis
 S PRIMAMIS=$G(SDINPUT("PRIMARY AMIS"))
 I PRIMAMIS D
 .S ERRORNUM=$$VALIDATEAMIS^SDES2UTIL($G(SDINPUT("PRIMARY AMIS")),"P")
 .I ERRORNUM D ERRLOG^SDES2JSON(.ERRORS,ERRORNUM,PRIMAMIS) Q
 I 'PRIMAMIS D ERRLOG^SDES2JSON(.ERRORS,479)
 ; Validate secondary Amis
 I $D(SDINPUT("CREDIT AMIS")) D VALCRSTOP(.ERRORS,.SDINPUT)
 ;
 ; Validate start/end dates
 S DATERESULT=$$VALISODATERANGE^SDES2VALISODTTM(.ERRORS,$G(SDINPUT("START DATE")),$G(SDINPUT("END DATE")),1)
 I '$D(ERRORS) S STARTDTFM=$P(DATERESULT,U),ENDDTFM=$P(DATERESULT,U,2)
 ; Validate number returned
 S NUMBERRET=$G(SDINPUT("NUMBER RETURNED"))
 I '$G(NUMBERRET) S (NUMBERRET,SDINPUT("NUMER RETURNED"))=100
 D VALNUM(.ERRORS,NUMBERRET)
 Q
GETAVAIL(RETURN,CLINLIST,START,END,STATION,NUMBER) ;
 N CLINNAME,RESOURCEIEN,SDERR,CLIN,GLOB,CNT,DONE,APPTDAT,APPTSTRT,APPTEND,AVAIL,SLOTS,DONE,AVAILDATE,SDECEND,BADATE,LOOP
 N PROV,PRVCNT,DEFAULTPROVIDER,APPTSTRTDTTM,TOTALAVAILCNT,APPTENDDTTM
 S (CNT,DONE)=0
 S CLIN="" F  S CLIN=$O(@CLINLIST@(CLIN),-1) Q:'CLIN!(DONE)  D
 .S GLOB=$NA(^TMP("SDES2CLINAVAIL",$J,CLIN)) K @GLOB
 .S BADATE=0
 .S AVAILDATE=$$FMADD^XLFDT(START,-1),SDECEND=END
 .F  S AVAILDATE=$$FMADD^XLFDT(AVAILDATE,1) Q:AVAILDATE>$P(SDECEND,".",1)!(BADATE>0)!(DONE)  D  ;
 ..I AVAILDATE<0 S BADATE=1 Q
 ..I ($O(^SC(CLIN,"T",0))="")!($O(^SC(CLIN,"T",0))>AVAILDATE) Q
 ..I $$GET1^DIQ(44,CLIN_",",1918.5,"I")'="Y",$D(^HOLIDAY("B",AVAILDATE)) Q   ;do not schedule on holidays
 ..Q:$$INACTIVE^SDESUTIL(CLIN,$P(AVAILDATE,".",1))   ;don't get availability if clinic inactive on day AVAILDATE
 ..D RESAB^SDEC57(GLOB,CLIN,AVAILDATE,AVAILDATE_"."_2359) Q:'$D(^TMP("SDES2CLINAVAIL",$J,CLIN))
 ..S LOOP=0 F  S LOOP=$O(^TMP("SDES2CLINAVAIL",$J,CLIN,LOOP)) Q:'LOOP!(DONE)  D
 ...S APPTDAT=$G(^TMP("SDES2CLINAVAIL",$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 ^TMP("SDES2CLINAVAIL",$J,"DATE",APPTSTRT,CLIN)=APPTEND_U_SLOTS
 S (TOTALAVAILCNT,DONE,CNT)=0
 S APPTSTRTDTTM=0 F  S APPTSTRTDTTM=$O(^TMP("SDES2CLINAVAIL",$J,"DATE",APPTSTRTDTTM)) Q:'APPTSTRTDTTM!(DONE)  D
 .S CLIN=0 F  S CLIN=$O(^TMP("SDES2CLINAVAIL",$J,"DATE",APPTSTRTDTTM,CLIN)) Q:'CLIN!(DONE)  D
 ..S AVAIL=$G(^TMP("SDES2CLINAVAIL",$J,"DATE",APPTSTRTDTTM,CLIN))
 ..S APPTENDDTTM=$P(AVAIL,U,1),SLOTS=$P(AVAIL,U,2)
 ..S TOTALAVAILCNT=TOTALAVAILCNT+SLOTS
 ..S CNT=CNT+1
 ..S RETURN("ClinicAvailability",CNT,"ClinicID")=CLIN
 ..S RETURN("ClinicAvailability",CNT,"ClinicName")=$$GET1^DIQ(44,CLIN,.01,"E")
 ..S RETURN("ClinicAvailability",CNT,"Visn")=$S($G(STATION)]"":$$VISN($G(SDINPUT("STATION"))),1:"")
 ..S RETURN("ClinicAvailability",CNT,"AppointmentStart")=$$FMTISO^SDAMUTDT(APPTSTRTDTTM)
 ..S RETURN("ClinicAvailability",CNT,"AppointmentEnd")=$$FMTISO^SDAMUTDT(APPTENDDTTM)
 ..S RETURN("ClinicAvailability",CNT,"AvailableSlots")=SLOTS
 ..S (PROV,PRVCNT)=0 F  S PROV=$O(^SC(CLIN,"PR",PROV)) Q:'PROV  D
 ...S PRVCNT=PRVCNT+1
 ...S RETURN("ClinicAvailability",CNT,"Provider",PRVCNT,"ProviderName")=$$GET1^DIQ(44.1,PROV_","_CLIN_",",.01,"E")
 ...S RETURN("ClinicAvailability",CNT,"Provider",PRVCNT,"ProviderId")=$$GET1^DIQ(44.1,PROV_","_CLIN_",",.01,"I")
 ...S DEFAULTPROVIDER=$$GET1^DIQ(44.1,PROV_","_CLIN_",",.02,"I")
 ...S DEFAULTPROVIDER=$S(DEFAULTPROVIDER'="":DEFAULTPROVIDER,1:0)
 ...S RETURN("ClinicAvailability",CNT,"Provider",PRVCNT,"DefaultProvider")=DEFAULTPROVIDER
 ..S RETURN("ClinicAvailability",CNT,"ClinicTimeZone")=$P($$TIMEZONEDATA^SDESUTIL(CLIN),"^",1)
 ..I TOTALAVAILCNT>=NUMBER S DONE=1 Q
 Q
MATCHCLIN(CLINLIST,STCODE,SDINPUT) ;
 N STOPIEN,CREDSTOPIEN,CREDSTOPIENS,CRSTLOOP,CRSTOPIEN,CLINIEN,STATION
 S STATION=$G(SDINPUT("STATION"))
 S STOPIEN=$$AMISTOSTOPCODE^SDESUTIL(STCODE)
 S CRSTLOOP=0 F  S CRSTLOOP=$O(SDINPUT("CREDIT AMIS",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 STATION]"",STATION'=$$STATIONNUMBER^SDES2UTIL(CLINIEN) Q
 .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
VALCRSTOP(ERRORS,SDINPUT) ;
 N SECAMIS,ERRORNUM
 S SECAMIS=0 F  S SECAMIS=$O(SDINPUT("CREDIT AMIS",SECAMIS)) Q:SECAMIS=""  D
 .S ERRORNUM=$$VALIDATEAMIS^SDES2UTIL(SECAMIS,"C")
 .I ERRORNUM D ERRLOG^SDES2JSON(.ERRORS,ERRORNUM,SECAMIS)
 Q
VALNUM(ERRORS,NUMBERRET) ;
 I $G(NUMBERRET)<1!($G(NUMBERRET)>100) D ERRLOG^SDESJSON(.ERRORS,382)
 Q
VISN(INSTNUM) ;
 N IEN,VISNPTR,VISN
 S VISN=0
 S IEN=$$IEN^XUAF4(INSTNUM)
 S:$G(IEN)>0 VISNPTR=$$GET1^DIQ(4.014,"1,"_IEN_",",1,"I")
 I $G(VISNPTR)>0 D
 .S VISN=$$GET1^DIQ(4,VISNPTR,.01,"I")
 .S VISN=$P(VISN," ",2)
 Q VISN