SDES2GETCLINST ;ALB/TJB,MCB/TJB - SDES2 GET CLINIC BY STOP CODE; July 07,2025
;;5.3;Scheduling;**914,915**;Aug 13, 1993;Build 2
;;Per VHA Directive 6402, this routine should not be modified
;
Q
; INPUT
;
; SDCONTEXT - STANDARD SDCONTEXT ARRAY
;
; SDCLINIC("PRIMARY STOP CODE",#) (One is Req)
; SDCLINIC("CREDIT STOP CODE",#) (Opt)
; SDCLINIC("RETURN INACTIVE")= 0|1 (Opt - Boolean) 0=Only Active Clinics 1=Active & Inactive
;
GETCLIN(RESULT,SDCONTEXT,SDCLINIC) ;
N CLIST,CLINIEN,I,OUT,OUT1,SDECI,ERRORS
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Clinic",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
D VALIDATE(.ERRORS,.SDCLINIC)
I $D(ERRORS) D Q
. S ERRORS("Clinic",1)=""
. D BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
D MATCHCLIN("CLIST",.SDCLINIC)
; Walk matching clinics and get the Clinic Info object
S I=1,CLINIEN="" F S CLINIEN=$O(CLIST(CLINIEN)) Q:CLINIEN="" D
. K OUT
. D BLDCLNREC^SDES2CLININFO(.OUT,CLINIEN)
. M OUT1("Clinic",I)=OUT("Clinic") S I=I+1
I '$D(OUT1) S OUT1("Clinic",1)=""
D BUILDJSON^SDES2JSON(.RESULT,.OUT1)
Q
VALIDATE(ERRORS,INPUT) ;
N I,STIEN,CRIEN,STCODE,CREDSTOP
I $G(INPUT("RETURN INACTIVE"))="" S INPUT("RETURN INACTIVE")=0 ; Default to active only
I ",0,1,"'[(","_INPUT("RETURN INACTIVE")_",") D ERRLOG^SDES2JSON(.ERRORS,518)
I $G(INPUT("PRIMARY STOP CODE",1))="" D ERRLOG^SDES2JSON(.ERRORS,479) Q
S I=0 F S I=I+1 S STCODE=$G(INPUT("PRIMARY STOP CODE",I)),CREDSTOP=$G(INPUT("CREDIT STOP CODE",I)) Q:$G(STCODE)="" D
. S STIEN=$$AMISTOSTOPCODE^SDES2UTIL($G(STCODE))
. S CRIEN=$$AMISTOSTOPCODE^SDES2UTIL($G(CREDSTOP))
. I STIEN=0 D ERRLOG^SDES2JSON(.ERRORS,270,"Code "_STCODE)
. I CREDSTOP'="",CRIEN=0 D ERRLOG^SDES2JSON(.ERRORS,271,"Code "_CREDSTOP)
. I $$GET1^DIQ(40.7,STIEN,2,"I")'="" D ERRLOG^SDES2JSON(.ERRORS,512) ; INACTIVE PRIMARY STOP CODE
. I $$GET1^DIQ(40.7,CRIEN,2,"I")'="" D ERRLOG^SDES2JSON(.ERRORS,513) ; INACTIVE CREDIT STOP CODE
Q
MATCHCLIN(CLINLIST,SDINPUT) ;
N STOPIEN,STCODE,CREDSTOP,CREDSTOPIEN,CRSTOPIEN,CLINIEN,I,RESULTS,INCLUDE,LST,INACT
S I=0 F S I=I+1 S STCODE=$G(SDINPUT("PRIMARY STOP CODE",I)),CREDSTOP=$G(SDINPUT("CREDIT STOP CODE",I)) Q:$G(STCODE)="" D
. K RESULTS D FIND^DIC(44,,"@;.01I;8I;2503I","P",STCODE,,"AST",,,"RESULTS")
. S LST=0 F S LST=$O(RESULTS("DILIST",LST)) Q:'+LST D
.. S INACT=$$INACTIVE^SDES2UTIL($P(RESULTS("DILIST",LST,0),U),DT)
.. S INCLUDE=$S(INACT=SDINPUT("RETURN INACTIVE"):1,INACT<SDINPUT("RETURN INACTIVE"):1,1:0)
.. Q:'INCLUDE
.. ; Filter non-matching credit stop codes
.. I CREDSTOP'="" S CREDSTOPIEN=$$AMISTOSTOPCODE^SDES2UTIL(CREDSTOP) Q:$P(RESULTS("DILIST",LST,0),U,4)'=CREDSTOPIEN
.. S @CLINLIST@($P(RESULTS("DILIST",LST,0),U))=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETCLINST 2767 printed Aug 26, 2025@23:10:10 Page 2
SDES2GETCLINST ;ALB/TJB,MCB/TJB - SDES2 GET CLINIC BY STOP CODE; July 07,2025
+1 ;;5.3;Scheduling;**914,915**;Aug 13, 1993;Build 2
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ; INPUT
+6 ;
+7 ; SDCONTEXT - STANDARD SDCONTEXT ARRAY
+8 ;
+9 ; SDCLINIC("PRIMARY STOP CODE",#) (One is Req)
+10 ; SDCLINIC("CREDIT STOP CODE",#) (Opt)
+11 ; SDCLINIC("RETURN INACTIVE")= 0|1 (Opt - Boolean) 0=Only Active Clinics 1=Active & Inactive
+12 ;
GETCLIN(RESULT,SDCONTEXT,SDCLINIC) ;
+1 NEW CLIST,CLINIEN,I,OUT,OUT1,SDECI,ERRORS
+2 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+3 IF $DATA(ERRORS)
SET ERRORS("Clinic",1)=""
DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
QUIT
+4 DO VALIDATE(.ERRORS,.SDCLINIC)
+5 IF $DATA(ERRORS)
Begin DoDot:1
+6 SET ERRORS("Clinic",1)=""
+7 DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+8 DO MATCHCLIN("CLIST",.SDCLINIC)
+9 ; Walk matching clinics and get the Clinic Info object
+10 SET I=1
SET CLINIEN=""
FOR
SET CLINIEN=$ORDER(CLIST(CLINIEN))
if CLINIEN=""
QUIT
Begin DoDot:1
+11 KILL OUT
+12 DO BLDCLNREC^SDES2CLININFO(.OUT,CLINIEN)
+13 MERGE OUT1("Clinic",I)=OUT("Clinic")
SET I=I+1
End DoDot:1
+14 IF '$DATA(OUT1)
SET OUT1("Clinic",1)=""
+15 DO BUILDJSON^SDES2JSON(.RESULT,.OUT1)
+16 QUIT
VALIDATE(ERRORS,INPUT) ;
+1 NEW I,STIEN,CRIEN,STCODE,CREDSTOP
+2 ; Default to active only
IF $GET(INPUT("RETURN INACTIVE"))=""
SET INPUT("RETURN INACTIVE")=0
+3 IF ",0,1,"'[(","_INPUT("RETURN INACTIVE")_",")
DO ERRLOG^SDES2JSON(.ERRORS,518)
+4 IF $GET(INPUT("PRIMARY STOP CODE",1))=""
DO ERRLOG^SDES2JSON(.ERRORS,479)
QUIT
+5 SET I=0
FOR
SET I=I+1
SET STCODE=$GET(INPUT("PRIMARY STOP CODE",I))
SET CREDSTOP=$GET(INPUT("CREDIT STOP CODE",I))
if $GET(STCODE)=""
QUIT
Begin DoDot:1
+6 SET STIEN=$$AMISTOSTOPCODE^SDES2UTIL($GET(STCODE))
+7 SET CRIEN=$$AMISTOSTOPCODE^SDES2UTIL($GET(CREDSTOP))
+8 IF STIEN=0
DO ERRLOG^SDES2JSON(.ERRORS,270,"Code "_STCODE)
+9 IF CREDSTOP'=""
IF CRIEN=0
DO ERRLOG^SDES2JSON(.ERRORS,271,"Code "_CREDSTOP)
+10 ; INACTIVE PRIMARY STOP CODE
IF $$GET1^DIQ(40.7,STIEN,2,"I")'=""
DO ERRLOG^SDES2JSON(.ERRORS,512)
+11 ; INACTIVE CREDIT STOP CODE
IF $$GET1^DIQ(40.7,CRIEN,2,"I")'=""
DO ERRLOG^SDES2JSON(.ERRORS,513)
End DoDot:1
+12 QUIT
MATCHCLIN(CLINLIST,SDINPUT) ;
+1 NEW STOPIEN,STCODE,CREDSTOP,CREDSTOPIEN,CRSTOPIEN,CLINIEN,I,RESULTS,INCLUDE,LST,INACT
+2 SET I=0
FOR
SET I=I+1
SET STCODE=$GET(SDINPUT("PRIMARY STOP CODE",I))
SET CREDSTOP=$GET(SDINPUT("CREDIT STOP CODE",I))
if $GET(STCODE)=""
QUIT
Begin DoDot:1
+3 KILL RESULTS
DO FIND^DIC(44,,"@;.01I;8I;2503I","P",STCODE,,"AST",,,"RESULTS")
+4 SET LST=0
FOR
SET LST=$ORDER(RESULTS("DILIST",LST))
if '+LST
QUIT
Begin DoDot:2
+5 SET INACT=$$INACTIVE^SDES2UTIL($PIECE(RESULTS("DILIST",LST,0),U),DT)
+6 SET INCLUDE=$SELECT(INACT=SDINPUT("RETURN INACTIVE"):1,INACT<SDINPUT("RETURN INACTIVE"):1,1:0)
+7 if 'INCLUDE
QUIT
+8 ; Filter non-matching credit stop codes
+9 IF CREDSTOP'=""
SET CREDSTOPIEN=$$AMISTOSTOPCODE^SDES2UTIL(CREDSTOP)
if $PIECE(RESULTS("DILIST",LST,0),U,4)'=CREDSTOPIEN
QUIT
+10 SET @CLINLIST@($PIECE(RESULTS("DILIST",LST,0),U))=""
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
