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 Dec 13, 2024@02:56:48 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
