SDES2GETCLNGRPS ;ALB/AGW - VISTA SCHEDULING RPCS TO GET CLINIC GROUPS; JUN 17,2025
;;5.3;Scheduling;**949**;Aug 13, 1993;Build 4
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to DUZ^XUP is supported by IA #7487
;
Q
;
; INPUT
; SDCONTEXT Array
;
; SDINPUT("STATION NUMBER") - station number (File 4) for SDES2 GET CLINIC GRPS BY STN
; SDINPUT("CLINIC IEN") - clinic IEN (File 44) for SDES2 GET CLINIC GRPS BY CLN IEN
;
GETCLNGRPSSTA(JSONRETURN,SDCONTEXT,SDINPUT) ; SDES2 GET CLINIC GRPS BY STN
N STATION,INST,ERRORS,CNT,DATA,CLINICIEN,CLNSTA,RETURNLIST,RETURNCLNGROUP
S DATA=$NA(^TMP("SDES2GETCLNSTA",$J,"DATA")) K @DATA
S JSONRETURN=$NA(^TMP("SDES2GETCLNSTA",$J,"JSON")) K @JSONRETURN
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("ClinicGroups",1)="" D ENCODE^XLFJSON("ERRORS",.JSONRETURN) Q
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
S STATION=$G(SDINPUT("STATION NUMBER"))
I STATION="" D ERRLOG^SDES2JSON(.ERRORS,196)
S INST=$$IEN^XUAF4(STATION)
I STATION]"",'INST D ERRLOG^SDES2JSON(.ERRORS,197)
I $D(ERRORS) S ERRORS("ClinicGroups",1)="" D ENCODE^XLFJSON("ERRORS",.JSONRETURN) Q
I $L(STATION>3) D
. S RETURNLIST(STATION)=1
. D BUILDLIST(.RETURNLIST,STATION)
S (CLINICIEN,CNT)=0
F S CLINICIEN=$O(^SC(CLINICIEN)) Q:'CLINICIEN D
.Q:$$GET1^DIQ(44,CLINICIEN,2,"I")'="C"
.S CLNSTA=$$CLINSTA(CLINICIEN) Q:CLNSTA=""
.I $L(STATION)=3,+CLNSTA'=STATION Q
.I $L(STATION)>3,'(+$G(RETURNLIST(CLNSTA))) Q
.D BUILDREC(.DATA,CLINICIEN,.CNT,.RETURNCLNGROUP)
.Q
S:(CNT=0) @DATA@("ClinicGroups",1)=""
D ENCODE^XLFJSON(.DATA,.JSONRETURN)
K @DATA
Q
;
GETCLNGRPSCLN(JSONRETURN,SDCONTEXT,SDINPUT) ; SDES2 GET CLN GRPS BY CLN IEN
N ERRORS,CNT,DATA,CLINICIEN,RETURNLIST,RETURNCLNGROUP
S DATA=$NA(^TMP("SDES2GETCLNGRPS",$J,"DATA")) K @DATA
S JSONRETURN=$NA(^TMP("SDES2GETCLNGRPS",$J,"JSON")) K @JSONRETURN
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("ClinicGroups",1)="" D ENCODE^XLFJSON("ERRORS",.JSONRETURN) Q
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
D VALCLINIEN^SDES2VAL44(.ERRORS,$G(SDINPUT("CLINIC IEN")),1)
I $D(ERRORS) S ERRORS("ClinicGroups",1)="" D ENCODE^XLFJSON("ERRORS",.JSONRETURN) Q
S CLINICIEN=$G(SDINPUT("CLINIC IEN"))
I $$GET1^DIQ(44,CLINICIEN,2,"I")'="C" D Q
.D ERRLOG^SDES2JSON(.ERRORS,20)
.S ERRORS("ClinicGroups",1)=""
.D ENCODE^XLFJSON("ERRORS",.JSONRETURN)
.Q
S DATA=$NA(^TMP("SDES2GETCLNGRPS",$J,"DATA")) K @DATA
S JSONRETURN=$NA(^TMP("SDES2GETCLNGRPS",$J,"JSON")) K @JSONRETURN
S CNT=0
D BUILDREC(.DATA,CLINICIEN,.CNT,.RETURNCLNGROUP)
S:(CNT=0) @DATA@("ClinicGroups",1)=""
D ENCODE^XLFJSON(.DATA,.JSONRETURN)
K @DATA
Q
;
CLINSTA(CLINICIEN) ;
N DIV,INST,STA
S DIV=$$GET1^DIQ(44,CLINICIEN,3.5,"I")
S INST=$$GET1^DIQ(40.8,DIV,.07,"I")
S STA=$$STA^XUAF4(INST)
Q STA
;
BUILDLIST(RETURNLIST,STATION) ;
N CHILDIEN,CHILDREN
D CHILDREN^XUAF4("CHILDREN",STATION,"PARENT FACILITY")
S CHILDIEN=""
F S CHILDIEN=$O(CHILDREN("C",CHILDIEN)) Q:CHILDIEN="" D
. S:$P(CHILDREN("C",CHILDIEN),U,2)'="" RETURNLIST($P(CHILDREN("C",CHILDIEN),U,2))=1
Q
;
BUILDREC(DATA,CLINICIEN,CNT,RETURNCLNGROUP) ;
N CLNGRPIEN,CLNRESOURCEIEN
S CLNRESOURCEIEN=$$GETRES^SDES2UTIL1(CLINICIEN)
Q:CLNRESOURCEIEN=""
Q:'$D(^SDEC(409.831,CLNRESOURCEIEN))
S CLNGRPIEN=0
F S CLNGRPIEN=$O(^SDEC(409.832,"AB",CLNRESOURCEIEN,CLNGRPIEN)) Q:(CLNGRPIEN="") D
.Q:($G(RETURNCLNGROUP(CLNGRPIEN)))
.S CNT=(+$G(CNT))+1
.S @DATA@("ClinicGroups",CNT,"ClinicGroupIen")=CLNGRPIEN
.S @DATA@("ClinicGroups",CNT,"ClinicGroupName")=$$GET1^DIQ(409.832,CLNGRPIEN,.01,"E")
.S RETURNCLNGROUP(CLNGRPIEN)=1
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETCLNGRPS 3772 printed Sep 17, 2026@21:40:14 Page 2
SDES2GETCLNGRPS ;ALB/AGW - VISTA SCHEDULING RPCS TO GET CLINIC GROUPS; JUN 17,2025
+1 ;;5.3;Scheduling;**949**;Aug 13, 1993;Build 4
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to DUZ^XUP is supported by IA #7487
+5 ;
+6 QUIT
+7 ;
+8 ; INPUT
+9 ; SDCONTEXT Array
+10 ;
+11 ; SDINPUT("STATION NUMBER") - station number (File 4) for SDES2 GET CLINIC GRPS BY STN
+12 ; SDINPUT("CLINIC IEN") - clinic IEN (File 44) for SDES2 GET CLINIC GRPS BY CLN IEN
+13 ;
GETCLNGRPSSTA(JSONRETURN,SDCONTEXT,SDINPUT) ; SDES2 GET CLINIC GRPS BY STN
+1 NEW STATION,INST,ERRORS,CNT,DATA,CLINICIEN,CLNSTA,RETURNLIST,RETURNCLNGROUP
+2 SET DATA=$NAME(^TMP("SDES2GETCLNSTA",$JOB,"DATA"))
KILL @DATA
+3 SET JSONRETURN=$NAME(^TMP("SDES2GETCLNSTA",$JOB,"JSON"))
KILL @JSONRETURN
+4 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+5 IF $DATA(ERRORS)
SET ERRORS("ClinicGroups",1)=""
DO ENCODE^XLFJSON("ERRORS",.JSONRETURN)
QUIT
+6 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+7 SET STATION=$GET(SDINPUT("STATION NUMBER"))
+8 IF STATION=""
DO ERRLOG^SDES2JSON(.ERRORS,196)
+9 SET INST=$$IEN^XUAF4(STATION)
+10 IF STATION]""
IF 'INST
DO ERRLOG^SDES2JSON(.ERRORS,197)
+11 IF $DATA(ERRORS)
SET ERRORS("ClinicGroups",1)=""
DO ENCODE^XLFJSON("ERRORS",.JSONRETURN)
QUIT
+12 IF $LENGTH(STATION>3)
Begin DoDot:1
+13 SET RETURNLIST(STATION)=1
+14 DO BUILDLIST(.RETURNLIST,STATION)
End DoDot:1
+15 SET (CLINICIEN,CNT)=0
+16 FOR
SET CLINICIEN=$ORDER(^SC(CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:1
+17 if $$GET1^DIQ(44,CLINICIEN,2,"I")'="C"
QUIT
+18 SET CLNSTA=$$CLINSTA(CLINICIEN)
if CLNSTA=""
QUIT
+19 IF $LENGTH(STATION)=3
IF +CLNSTA'=STATION
QUIT
+20 IF $LENGTH(STATION)>3
IF '(+$GET(RETURNLIST(CLNSTA)))
QUIT
+21 DO BUILDREC(.DATA,CLINICIEN,.CNT,.RETURNCLNGROUP)
+22 QUIT
End DoDot:1
+23 if (CNT=0)
SET @DATA@("ClinicGroups",1)=""
+24 DO ENCODE^XLFJSON(.DATA,.JSONRETURN)
+25 KILL @DATA
+26 QUIT
+27 ;
GETCLNGRPSCLN(JSONRETURN,SDCONTEXT,SDINPUT) ; SDES2 GET CLN GRPS BY CLN IEN
+1 NEW ERRORS,CNT,DATA,CLINICIEN,RETURNLIST,RETURNCLNGROUP
+2 SET DATA=$NAME(^TMP("SDES2GETCLNGRPS",$JOB,"DATA"))
KILL @DATA
+3 SET JSONRETURN=$NAME(^TMP("SDES2GETCLNGRPS",$JOB,"JSON"))
KILL @JSONRETURN
+4 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+5 IF $DATA(ERRORS)
SET ERRORS("ClinicGroups",1)=""
DO ENCODE^XLFJSON("ERRORS",.JSONRETURN)
QUIT
+6 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+7 DO VALCLINIEN^SDES2VAL44(.ERRORS,$GET(SDINPUT("CLINIC IEN")),1)
+8 IF $DATA(ERRORS)
SET ERRORS("ClinicGroups",1)=""
DO ENCODE^XLFJSON("ERRORS",.JSONRETURN)
QUIT
+9 SET CLINICIEN=$GET(SDINPUT("CLINIC IEN"))
+10 IF $$GET1^DIQ(44,CLINICIEN,2,"I")'="C"
Begin DoDot:1
+11 DO ERRLOG^SDES2JSON(.ERRORS,20)
+12 SET ERRORS("ClinicGroups",1)=""
+13 DO ENCODE^XLFJSON("ERRORS",.JSONRETURN)
+14 QUIT
End DoDot:1
QUIT
+15 SET DATA=$NAME(^TMP("SDES2GETCLNGRPS",$JOB,"DATA"))
KILL @DATA
+16 SET JSONRETURN=$NAME(^TMP("SDES2GETCLNGRPS",$JOB,"JSON"))
KILL @JSONRETURN
+17 SET CNT=0
+18 DO BUILDREC(.DATA,CLINICIEN,.CNT,.RETURNCLNGROUP)
+19 if (CNT=0)
SET @DATA@("ClinicGroups",1)=""
+20 DO ENCODE^XLFJSON(.DATA,.JSONRETURN)
+21 KILL @DATA
+22 QUIT
+23 ;
CLINSTA(CLINICIEN) ;
+1 NEW DIV,INST,STA
+2 SET DIV=$$GET1^DIQ(44,CLINICIEN,3.5,"I")
+3 SET INST=$$GET1^DIQ(40.8,DIV,.07,"I")
+4 SET STA=$$STA^XUAF4(INST)
+5 QUIT STA
+6 ;
BUILDLIST(RETURNLIST,STATION) ;
+1 NEW CHILDIEN,CHILDREN
+2 DO CHILDREN^XUAF4("CHILDREN",STATION,"PARENT FACILITY")
+3 SET CHILDIEN=""
+4 FOR
SET CHILDIEN=$ORDER(CHILDREN("C",CHILDIEN))
if CHILDIEN=""
QUIT
Begin DoDot:1
+5 if $PIECE(CHILDREN("C",CHILDIEN),U,2)'=""
SET RETURNLIST($PIECE(CHILDREN("C",CHILDIEN),U,2))=1
End DoDot:1
+6 QUIT
+7 ;
BUILDREC(DATA,CLINICIEN,CNT,RETURNCLNGROUP) ;
+1 NEW CLNGRPIEN,CLNRESOURCEIEN
+2 SET CLNRESOURCEIEN=$$GETRES^SDES2UTIL1(CLINICIEN)
+3 if CLNRESOURCEIEN=""
QUIT
+4 if '$DATA(^SDEC(409.831,CLNRESOURCEIEN))
QUIT
+5 SET CLNGRPIEN=0
+6 FOR
SET CLNGRPIEN=$ORDER(^SDEC(409.832,"AB",CLNRESOURCEIEN,CLNGRPIEN))
if (CLNGRPIEN="")
QUIT
Begin DoDot:1
+7 if ($GET(RETURNCLNGROUP(CLNGRPIEN)))
QUIT
+8 SET CNT=(+$GET(CNT))+1
+9 SET @DATA@("ClinicGroups",CNT,"ClinicGroupIen")=CLNGRPIEN
+10 SET @DATA@("ClinicGroups",CNT,"ClinicGroupName")=$$GET1^DIQ(409.832,CLNGRPIEN,.01,"E")
+11 SET RETURNCLNGROUP(CLNGRPIEN)=1
+12 QUIT
End DoDot:1
+13 QUIT
