DVBACRVA ;SLC/GRE - ; 01/08/2016
 ;;2.7;AMIE;**193**;AUG 30,2016;Build 84
 ;
 ;Public, Supported ICRs
 ; #2056 - Fileman API - $$GET1^DIQ
 ;
 
Q
 
;
GETFAC(RESULT,SORTBY)   ; Extract records from file and sort by State Code
 
^TMP($J)
 
II,FACNAME,STATE,ST,STATION,STATX,FIEN,FACTYPE,R,F1,F11,F2,F2N
 
VAMCNAME,A1,RES,X,X1
 
(FACNAME,STATE,ST,STATION,STATX,FIEN,FACTYPE,F1,F11,F2,F2N,VAMCNAME)=""
 
(R,II)=0
 
; % IS THE FIRST XREF
 
F  S II=$O(^DVB(396.195,II)) Q:II=""  Q:II="B"  D
  
X=^DVB(396.195,II,0)
  . 
;S X1=$G(^DIC(4,II,99))  ;sSTATION NUMBER;$G SETS TO NULL IF RECORD DOES NOT EXIST
  
FACNAME=$P(X,U,1)
  . 
FNAME=$P(FACNAME,"located",1)
  . 
ST=$P(X,U,2)
  . 
STATION=$$DSTAT(IIQ:STATION=""
  
S:SORTBY="STATE" RES(ST,II)=U_FACNAME_U_II_U_STATION
  
S:SORTBY="NAME" RESULT(FNAME)=U_FACNAME_U_II_U_STATION
 
SORTBY="STATE" (R,II)=0,ST="" D
  
CNT CNT=0
  . 
F  S ST=$O(RES(ST)) Q:ST=""  D
  
.. II=0
  .. 
F  S II=$O(RES(ST,II)) Q:II=""  D
  
... CNT=$G(CNT)+1
  ... 
RESULT(CNT)=RES(ST,II)
  
Q
  
;
DSTAT(RSI) ; Returns Domain Station Number
  ;
  
DMNI,DMN
  
Q:RSI="" 0
  
Q:'$D(^DVB(396.195,RSI,0)) 0
  
;
  
DMN=$P(^DVB(396.195,RSI,0),"^",3)
  
DMNI=$O(^DIC(4.2,"B",DMN,""))
  
Q:DMNI="" 0
  
STN=$P(^DIC(4.2,DMNI,0),"^",13)
  
STN
  
;
GETFACNM(RESULT,SORTBY)   ; Extract records from file and sort by State Code
  
^TMP($J)
  
II,FACNAME,STATE,ST,STATION,STATX,FIEN,FACTYPE,R,F1,F11,F2,F2N
  
VAMCNAME,A1,RES,X,X1
  
(FACNAME,STATE,ST,STATION,STATX,FIEN,FACTYPE,F1,F11,F2,F2N,VAMCNAME)=""
  
(R,II)=0
  
; % IS THE FIRST XREF
  
F  S II=$O(^DIC(4,II)) Q:II=""  Q:II="%"  D
  
X=^DIC(4,II,0),R=0
  . 
X1=$G(^DIC(4,II,99))  ;$G SETS TO NULL IF RECORD DOES NOT EXIST
  
F11=$P(X1,U,4)  ;INACTIVE FLAG - POINTER
  
Q:F11=1  ;QUIT IF F1=INACTIVE=1
  
F1=$G(^DIC(4,II,3))
  . 
Q:F1=""
  
F2=$G(^DIC(4.1,F1,0))
  . 
F2N=$P(F2,U,1)
  . 
A1=$P(F2,U,1)
  . 
FACNAME=$P(X,U,1)
  . 
"VAMC"[F2N R=1
  . 
"BVA/VBA-SO"[F2N R=1
  . 
"RO"[F2N R=1
  . 
"CENTRAL OFFICE"[F2N R=1
  . 
"BVA"[F2N R=1
  . 
"M&ROC"[F2N R=1
  . 
"MC&RO"[F2N R=1
  . 
"RO-OC"[F2N R=1
  . 
"RO&IC"[F2N R=1
  . 
"VAMROC"[F2N R=1
  . 
"-RO"[F2N R=1
  . 
"VAHSRO"[F2N R=1
  . 
"TIGER TEAM"[F2N R=1
  . 
II=460 R=1
  . 
Q:R=0
  . 
FACNAME=$P(X,U,1)
  . 
STATE=$P(X,U,2) STATE="" Q:STATE=""
  
STATION=$P(X1,U,1)
  . 
FIEN=$P(X,U,1)
  . 
ST=$$EXTERNAL^DILFD(4,.02,"",STATE)
  . 
S:SORTBY="STATE" RES(ST,II)=ST_U_FACNAME_U_STATION_U_II_U_A1
  
S:SORTBY="NAME" RESULT(FACNAME)=ST_U_FACNAME_U_STATION_U_II
  
SORTBY="STATE" (R,II)=0,ST="" D
 
CNT CNT=0
 . 
F  S ST=$O(RES(ST)) Q:ST=""  D
 
.. II=0
 .. 
F  S II=$O(RES(ST,II)) Q:II=""  D
 
... CNT=$G(CNT)+1
 ... 
RESULT(CNT)=RES(ST,II)
 
Q