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

SDES2GETCLNSTA.m

Go to the documentation of this file.
SDES2GETCLNSTA ;ALB/BWF - SDES2 GET CLINICS BY STATION; JUL 17,2024
 ;;5.3;Scheduling;**886**;Aug 13, 1993;Build 13
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 Q
 ;
 ; INPUT
 ; SDCONTEXT Array
 ;
 ; SDINPUT("STATION NUMBER") - station number
 ; SDINPUT("ACTIVE ONLY") - set to '1' if only active clinics should be included (if nothing is sent, active and inactive clinics are returned)
 ;
GETCLINICS(JSONRETURN,SDCONTEXT,SDINPUT) ;
 N STATION,INST,ERRORS,CNT,DATA,CLINIEN,CLNSTA
 S DATA=$NA(^TMP("SDES2GETCLNSTA",$J,"DATA")) K @DATA
 ; validate context
 S JSONRETURN=$NA(^TMP("SDES2GETCLNSTA",$J,"JSON")) K @JSONRETURN
 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
 I $D(ERRORS) S ERRORS("Clinic",1)="" D ENCODE^XLFJSON("ERRORS",.JSONRETURN) Q
 ; validate SDINPUT
 I $D(SDINPUT("ACTIVE ONLY")),$G(SDINPUT("ACTIVE ONLY"))'=1 D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid 'ACTIVE ONLY' flag.")
 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("Clinic",1)="" D ENCODE^XLFJSON("ERRORS",.JSONRETURN) Q
 ;
 S (CLINIEN,CNT)=0
 F  S CLINIEN=$O(^SC(CLINIEN)) Q:'CLINIEN  D
 .Q:$$GET1^DIQ(44,CLINIEN,2,"I")'="C"
 .S CLNSTA=$$CLINSTA(CLINIEN) Q:CLNSTA=""
 .I $L(STATION)=3,+CLNSTA'=STATION Q
 .I $L(STATION)>3,CLNSTA'=STATION Q
 .I $G(SDINPUT("ACTIVE ONLY")) Q:$$INACTIVE^SDES2UTIL(CLINIEN,DT)
 .S CNT=CNT+1
 .S @DATA@("Clinic",CNT,"ClinicIen")=CLINIEN
 .S @DATA@("Clinic",CNT,"ResourceIen")=$O(^SDEC(409.831,"ALOC",CLINIEN,0))
 .S @DATA@("Clinic",CNT,"Name")=$$GET1^DIQ(44,CLINIEN,.01,"E")
 I '$D(@DATA) S @DATA@("Clinic",1)=""
 D ENCODE^XLFJSON(.DATA,.JSONRETURN)
 K @DATA
 Q
CLINSTA(CLINIEN) ;
 N DIV,INST,STA
 S DIV=$$GET1^DIQ(44,CLINIEN,3.5,"I")
 S INST=$$GET1^DIQ(40.8,DIV,.07,"I")
 S STA=$$STA^XUAF4(INST)
 Q STA