HMPTFU2 ;ASMR/JCH,CK,DKK - Utilities for the Treating Facility file 391.91 ;Apr 27, 2016 10:35:07
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;May 15, 2016;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; DIQ 2056 ;DE6363 - JD - 8/23/16
;
; Reference to ^DGCN(391.91 is NOT currently supported; see ICR #2911 for an existing Private ICR between
; Registration and CIRN that would meet the needs of this routine, or provide an example for a new ICR.
;
Q
;
TFL(LIST,PT) ;for this PT [patient] (either DFN, ICN or EDIPI) return the list of treating facilities
; CALLED FROM RPC HMP LOCAL GET CORRESPONDINGIDS
; PT values : Source ID^Source ID Type^Assigning Authority^Assigning Facility
; ICN example: 1008520438V882204^NI^USVHA^200M
; DFN example: 100000511^PI^USVHA^500
; EDIPI example: 852043888^NI^USDOD^200DOD
;
; SOURCE ID: SOURCE ID is the unique system assigned identifier at the identified facility for the
; patient record. The value of SOURCE ID varies, depending on the source facility.
; If SOURCE ID is from the Master Patient Index, the value is the Integration
; Control Number (ICN). If SOURCE ID is from the Department of Defense (DOD), the
; value is the Electronic Data Interchange Personal Identifier (EDIPI), which is
; their equivalent of an ICN. In the future, SOURCE ID may come from other sources
; due to additional initiatives.
;
; SOURCE ID TYPE: SOURCE ID TYPE defines the data source for the TREATING FACILITY LIST file (#391.91) entry.
; The source ID type is a reference to the HL7 Table 0203, Identifier Type, and the VA
; Identity Management user defined values: NI (National Identifier), PI (Patient Identifier)
;
; Return:
; This will return the ICN and the list of treating facilities in the following format:
; RESULT(n)=Id^IdType^AssigningFacility^AssigningAuthority^IdStatus
; Examples:
; RESULT(1)="1011232151V598646^NI^200M^A"
; RESULT(2)="7168937^PI^91E3^USVHA^A"
; RESULT(3)="852043888^NI^200DOD^USDOD^A"
;
; ID STATUS: ID STATUS supports joint VA/DoD medical centers, Veteran's Record Management (VRM), and Virtual
; Lifetime Electronic Record (VLER) initiatives. This field allows the capture of resolved
; duplicate events and exposes the related identifier and identifier status to the consuming
; applications. A value of ""A"" indicates that the patient record is an active record on
; the identifying system (e.g., VAMC or DoD). A value of "H" indicates that the patient
; record was identified as part of a duplicate pair, has been merged, and is no longer active
; on the identifying system (e.g., VAMC or DoD).
;
N X,ICN,DFN,EDIPI,ASSIGN,ID,SITE,TYPE,SITEIEN,TFIEN
;
; Master Patient Index (MPI) must be installed to continue
S X="MPIF001" X ^%ZOSF("TEST") I '$T S LIST(1)="-1^MPI Not Installed" Q
;
K LIST ; Clear "return" variable
;
; what do we have
S TYPE=$P(PT,"^",2) ; SOURCE ID TYPE
S SITE=$P(PT,"^",4) ;
S ID=$P(PT,"^")
S ASSIGN=$P(PT,"^",3)
; check input data
I ID']"" S LIST(1)="-1^Id is not defined." Q
I TYPE'="NI",TYPE'="PI" S LIST(1)="-1^Invalid Id Type." Q
I ASSIGN'="USVHA",ASSIGN'="USDOD" S LIST(1)="-1^Invalid Assigning Authority." Q
I SITE']"" S LIST(1)="-1^Missing Assigning Facility." Q
; find the ien for the station number
S SITEIEN=$$FIND1^DIC(4,"","X",SITE,"D")
I 'SITEIEN S LIST(1)="-1^Assigning Facility is not defined in database." Q
I TYPE="PI",ASSIGN="USVHA" S DFN=ID
I TYPE="NI",ASSIGN="USVHA",SITE="200M" S ICN=ID
I TYPE="NI",ASSIGN="USDOD",SITE="200DOD" S EDIPI=ID
I $D(ICN) S DFN=$$GETDFN^MPIF001(ICN) D Q:$D(LIST(1))
. I +DFN<0 S LIST(1)="-1^ICN is not known" Q
. S SITEIEN=$$IEN^XUAF4($P($$SITE^VASITE,"^",3))
;
I $D(DFN) S ICN=$$GETICN^MPIF001(DFN)
; DFN should be defined, but ICN may not.
;Use new xref AISS appropriately to retrieve DFN from EDIPI
I $D(EDIPI)=""!(ASSIGN="")!(TYPE="")!(SITEIEN="") S LIST(1)="-1^Insufficient data" Q
I $D(EDIPI),'$D(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN)) D Q
. S LIST(1)="-1^EDIPI Record is unknown at this facility"
I $D(EDIPI),$D(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN)) D
.S EN=$O(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN,0))
.S DFN=$P($G(^DGCN(391.91,EN,0)),"^")
;
; if ICN is not defined, it is OK, but DFN should be defined
; bad input, such as Id^NI^USVHA^123
I '$G(DFN) S LIST(1)="-1^Invalid input" Q
; check DFN and Site to be matching an entry in file #391.91
I '$O(^DGCN(391.91,"APAT",DFN,SITEIEN,0)) D Q
. S LIST(1)="-1^Id as '"_ID_"'"_" is not in database"
; DFN should be defined, but ICN may not.
S X=$$QUERYTF($P($G(ICN),"V"),"LIST")
I $P(X,U)="1" S LIST(1)="-1"_U_$P(X,U,2) Q
Q
;
GETICN(EDIPI) ;return the ICN when EDIPI is passed
N EN,DFN,ICN,IEN
S IEN=$$IEN^XUAF4("200DOD")
I 'IEN Q "-1^Unknown Assigning Facility."
I '$D(^DGCN(391.91,"ASCR",EDIPI,IEN)) Q "-1^EDIPI Record is unknown at this facility"
I $D(^DGCN(391.91,"ASCR",EDIPI,IEN)) D
.S EN=$O(^DGCN(391.91,"ASCR",EDIPI,$$IEN^XUAF4("200DOD"),""))
.S DFN=$P($G(^DGCN(391.91,EN,0)),"^")
.I DFN'="" S ICN=$$GETICN^MPIF001(DFN)
.I DFN="" S ICN="-1^No Site Record associated with this entry"
Q ICN
;
QUERYTF(PAT,ARY) ;a query for Treating Facility.
;INPUT PAT - The patient's ICN
; ARY - The array in which to return the Treating facility info.
;OUTPUT A list of the Treating Facilities in the array provided from
; the parameter. It will be in the structure of x(1), x(2) etc.
; Ex X(1)=<ID> ^ <ID TYPE> ^ <Assigning Authority> ^ <Assigning Facility> ^ <ID Status>
;
; This is also a function call. If there is an error then "1^error description" will be returned.
; If no data is found the array will not be populated and "1^error description" will be returned.
;
N PDFN,HMPER,LP,CTR
;
; ICN is not required
I ('$D(ARY)) S HMPER="1^Parameter missing." G QUERYTFQ
S HMPER=0,CTR=1
S X="MPIF001" X ^%ZOSF("TEST") I '$T G QUERYTFQ
S PDFN=$G(DFN)
I '$G(PDFN) S HMPER="1^DFN is not defined." G QUERYTFQ
;SET FIRST ENTRY TO BE THE ICN - FULL ICN - PAT IS NOT THE ICN
S @ARY@(CTR)=$$GETICN^MPIF001(PDFN)_"^NI^200M^USVHA^A"
;**856 - MVI 1371 (ckn)
;Loop through all TFIENs for site
;F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:'LP S TFIEN=$O(^(LP,"")) D SET(TFIEN,ARY,.CTR)
F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:'LP D
.S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,TFIEN)) Q:'TFIEN D
..D SET(TFIEN,ARY,.CTR)
I $D(@ARY)'>9 S HMPER="1^Could not find Treating Facilities"
QUERYTFQ Q HMPER
;
SET(TFIEN,ARY,CTR) ;This sets the array with the treating facility list.
; Ex ARY(1)=<ID> ^ <ID TYPE> ^ <Assigning Facility> ^ <Assigning Authority> ^ <ID Status>
N DGCN,INSTIEN,SOURCE,EN,SDFN,STATUS,SITEN,ID,IDTYPE,SITE,ASSAUTH,FOUND,NODE,NODE0,NODE2,STNNUM
S DGCN(0)=$G(^DGCN(391.91,TFIEN,0)),SITEN=""
;
S INSTIEN=$P($G(DGCN(0)),"^",2) ; TREATING FACILITY LIST (#391.91) INSTITUTION field (#.02)
I INSTIEN'="" S SITEN=$$STA^XUAF4(INSTIEN) ; STATION from Institution IEN
S ID=$P(DGCN(0),"^") ; ID=Patient DFN field (#.01)
S STNNUM=SITEN
;
S NODE2=$G(^DGCN(391.91,TFIEN,2))
S SDFN=$P(NODE2,"^",2) ; SDFN="SOURCE ID"
S STATUS=$P(NODE2,"^",3) ; STATUS="IDENTIFIER STATUS"
S ASSAUTH=$P(NODE2,"^") ; Assigning Authority
;
S NODE0=$G(^DGCN(391.91,TFIEN,0))
S IDTYPE=$P(NODE0,"^",9) ; SOURCE ID TYPE
;
I SITEN="200DOD"!(SITEN["200N") S IDTYPE="NI"
I SITEN="200DOD" S ASSAUTH="USDOD"
I IDTYPE="" S IDTYPE="PI"
I ASSAUTH="" S ASSAUTH="USVHA"
I SITEN["200N"&(IDTYPE="NI")&(ASSAUTH="USVHA") S ASSAUTH=""
I IDTYPE="PI" S SITEN=$$TF2SITEN(TFIEN) Q:(SITEN=""&(STNNUM'="742V1"))
;
; If VA Internal Patient ID, get site hash from domain associated with Treating Facility
S NODE0=$G(^DGCN(391.91,TFIEN,0))
S NODE2=$G(^DGCN(391.91,TFIEN,2))
S SDFN=$P(NODE2,"^",2),STATUS=$P(NODE2,"^",3),IDTYPE=$P(NODE0,"^",9)
; DE2345 - MBS 9/15/2015; Only return active entries
I STATUS'="A" Q
S ASSAUTH=$P(NODE2,"^")
I SITEN="200DOD"!(SITEN["200N") S IDTYPE="NI"
I SITEN="200DOD" S ASSAUTH="USDOD"
I IDTYPE="" S IDTYPE="PI"
I ASSAUTH="" S ASSAUTH="USVHA"
I SITEN["200N"&(IDTYPE="NI")&(ASSAUTH="USVHA") S ASSAUTH=""
I SDFN'="" S CTR=CTR+1,@ARY@(CTR)=SDFN_"^"_IDTYPE_"^"_SITEN_"^"_ASSAUTH_"^"_STATUS_"^"_STNNUM,FOUND=1
Q
TF2SITEN(TFIEN) ;Find the DOMAIN associated with the TREATING FACILITY and return the station number.
;Currently, our test systems' station numbers are not set up for local DOMAINs. This would result in these
;entries failing all the time, thus breaking existing behavior. For the time being, we will default to
;the old behavior if we cannot locate a station number as a temporary measure. In the future, we need to
;fix the test systems to set up the station numbers correctly, and then change this code to return
;an empty string if the DOMAIN could not be resolved.
S SITEN=""
Q:'+$G(TFIEN) ""
Q:'$D(^DGCN(391.91,TFIEN)) ""
;Get station number from Institution file (pointed to from Treating Facility List)
N INSTNUM,STNNUM,DONE,I
S INSTNUM=$P($G(^DGCN(391.91,TFIEN,0)),U,2) Q:'+INSTNUM SITEN
S STNNUM=$$GET1^DIQ(4,INSTNUM_",",99) ;ICR 2056
Q:'+STNNUM SITEN
;DE2345 - MBS 9/15/2015; Do not return entries with station numbers=+200
I STNNUM?1"200".A Q ""
;Domain file doesn't have an x-ref on station number, so we have to brute-force it
S (I,DONE)=0 F S I=$O(^DIC(4.2,I)) Q:'+I D Q:DONE
. I $P(^DIC(4.2,I,0),U,13)=STNNUM S SITEN=$$SYS^HMPUTILS($P(^DIC(4.2,I,0),U)),DONE=1
Q SITEN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPTFU2 10060 printed Apr 09, 2024@20:59:05 Page 2
HMPTFU2 ;ASMR/JCH,CK,DKK - Utilities for the Treating Facility file 391.91 ;Apr 27, 2016 10:35:07
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;May 15, 2016;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; DIQ 2056 ;DE6363 - JD - 8/23/16
+7 ;
+8 ; Reference to ^DGCN(391.91 is NOT currently supported; see ICR #2911 for an existing Private ICR between
+9 ; Registration and CIRN that would meet the needs of this routine, or provide an example for a new ICR.
+10 ;
+11 QUIT
+12 ;
TFL(LIST,PT) ;for this PT [patient] (either DFN, ICN or EDIPI) return the list of treating facilities
+1 ; CALLED FROM RPC HMP LOCAL GET CORRESPONDINGIDS
+2 ; PT values : Source ID^Source ID Type^Assigning Authority^Assigning Facility
+3 ; ICN example: 1008520438V882204^NI^USVHA^200M
+4 ; DFN example: 100000511^PI^USVHA^500
+5 ; EDIPI example: 852043888^NI^USDOD^200DOD
+6 ;
+7 ; SOURCE ID: SOURCE ID is the unique system assigned identifier at the identified facility for the
+8 ; patient record. The value of SOURCE ID varies, depending on the source facility.
+9 ; If SOURCE ID is from the Master Patient Index, the value is the Integration
+10 ; Control Number (ICN). If SOURCE ID is from the Department of Defense (DOD), the
+11 ; value is the Electronic Data Interchange Personal Identifier (EDIPI), which is
+12 ; their equivalent of an ICN. In the future, SOURCE ID may come from other sources
+13 ; due to additional initiatives.
+14 ;
+15 ; SOURCE ID TYPE: SOURCE ID TYPE defines the data source for the TREATING FACILITY LIST file (#391.91) entry.
+16 ; The source ID type is a reference to the HL7 Table 0203, Identifier Type, and the VA
+17 ; Identity Management user defined values: NI (National Identifier), PI (Patient Identifier)
+18 ;
+19 ; Return:
+20 ; This will return the ICN and the list of treating facilities in the following format:
+21 ; RESULT(n)=Id^IdType^AssigningFacility^AssigningAuthority^IdStatus
+22 ; Examples:
+23 ; RESULT(1)="1011232151V598646^NI^200M^A"
+24 ; RESULT(2)="7168937^PI^91E3^USVHA^A"
+25 ; RESULT(3)="852043888^NI^200DOD^USDOD^A"
+26 ;
+27 ; ID STATUS: ID STATUS supports joint VA/DoD medical centers, Veteran's Record Management (VRM), and Virtual
+28 ; Lifetime Electronic Record (VLER) initiatives. This field allows the capture of resolved
+29 ; duplicate events and exposes the related identifier and identifier status to the consuming
+30 ; applications. A value of ""A"" indicates that the patient record is an active record on
+31 ; the identifying system (e.g., VAMC or DoD). A value of "H" indicates that the patient
+32 ; record was identified as part of a duplicate pair, has been merged, and is no longer active
+33 ; on the identifying system (e.g., VAMC or DoD).
+34 ;
+35 NEW X,ICN,DFN,EDIPI,ASSIGN,ID,SITE,TYPE,SITEIEN,TFIEN
+36 ;
+37 ; Master Patient Index (MPI) must be installed to continue
+38 SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET LIST(1)="-1^MPI Not Installed"
QUIT
+39 ;
+40 ; Clear "return" variable
KILL LIST
+41 ;
+42 ; what do we have
+43 ; SOURCE ID TYPE
SET TYPE=$PIECE(PT,"^",2)
+44 ;
SET SITE=$PIECE(PT,"^",4)
+45 SET ID=$PIECE(PT,"^")
+46 SET ASSIGN=$PIECE(PT,"^",3)
+47 ; check input data
+48 IF ID']""
SET LIST(1)="-1^Id is not defined."
QUIT
+49 IF TYPE'="NI"
IF TYPE'="PI"
SET LIST(1)="-1^Invalid Id Type."
QUIT
+50 IF ASSIGN'="USVHA"
IF ASSIGN'="USDOD"
SET LIST(1)="-1^Invalid Assigning Authority."
QUIT
+51 IF SITE']""
SET LIST(1)="-1^Missing Assigning Facility."
QUIT
+52 ; find the ien for the station number
+53 SET SITEIEN=$$FIND1^DIC(4,"","X",SITE,"D")
+54 IF 'SITEIEN
SET LIST(1)="-1^Assigning Facility is not defined in database."
QUIT
+55 IF TYPE="PI"
IF ASSIGN="USVHA"
SET DFN=ID
+56 IF TYPE="NI"
IF ASSIGN="USVHA"
IF SITE="200M"
SET ICN=ID
+57 IF TYPE="NI"
IF ASSIGN="USDOD"
IF SITE="200DOD"
SET EDIPI=ID
+58 IF $DATA(ICN)
SET DFN=$$GETDFN^MPIF001(ICN)
Begin DoDot:1
+59 IF +DFN<0
SET LIST(1)="-1^ICN is not known"
QUIT
+60 SET SITEIEN=$$IEN^XUAF4($PIECE($$SITE^VASITE,"^",3))
End DoDot:1
if $DATA(LIST(1))
QUIT
+61 ;
+62 IF $DATA(DFN)
SET ICN=$$GETICN^MPIF001(DFN)
+63 ; DFN should be defined, but ICN may not.
+64 ;Use new xref AISS appropriately to retrieve DFN from EDIPI
+65 IF $DATA(EDIPI)=""!(ASSIGN="")!(TYPE="")!(SITEIEN="")
SET LIST(1)="-1^Insufficient data"
QUIT
+66 IF $DATA(EDIPI)
IF '$DATA(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN))
Begin DoDot:1
+67 SET LIST(1)="-1^EDIPI Record is unknown at this facility"
End DoDot:1
QUIT
+68 IF $DATA(EDIPI)
IF $DATA(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN))
Begin DoDot:1
+69 SET EN=$ORDER(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN,0))
+70 SET DFN=$PIECE($GET(^DGCN(391.91,EN,0)),"^")
End DoDot:1
+71 ;
+72 ; if ICN is not defined, it is OK, but DFN should be defined
+73 ; bad input, such as Id^NI^USVHA^123
+74 IF '$GET(DFN)
SET LIST(1)="-1^Invalid input"
QUIT
+75 ; check DFN and Site to be matching an entry in file #391.91
+76 IF '$ORDER(^DGCN(391.91,"APAT",DFN,SITEIEN,0))
Begin DoDot:1
+77 SET LIST(1)="-1^Id as '"_ID_"'"_" is not in database"
End DoDot:1
QUIT
+78 ; DFN should be defined, but ICN may not.
+79 SET X=$$QUERYTF($PIECE($GET(ICN),"V"),"LIST")
+80 IF $PIECE(X,U)="1"
SET LIST(1)="-1"_U_$PIECE(X,U,2)
QUIT
+81 QUIT
+82 ;
GETICN(EDIPI) ;return the ICN when EDIPI is passed
+1 NEW EN,DFN,ICN,IEN
+2 SET IEN=$$IEN^XUAF4("200DOD")
+3 IF 'IEN
QUIT "-1^Unknown Assigning Facility."
+4 IF '$DATA(^DGCN(391.91,"ASCR",EDIPI,IEN))
QUIT "-1^EDIPI Record is unknown at this facility"
+5 IF $DATA(^DGCN(391.91,"ASCR",EDIPI,IEN))
Begin DoDot:1
+6 SET EN=$ORDER(^DGCN(391.91,"ASCR",EDIPI,$$IEN^XUAF4("200DOD"),""))
+7 SET DFN=$PIECE($GET(^DGCN(391.91,EN,0)),"^")
+8 IF DFN'=""
SET ICN=$$GETICN^MPIF001(DFN)
+9 IF DFN=""
SET ICN="-1^No Site Record associated with this entry"
End DoDot:1
+10 QUIT ICN
+11 ;
QUERYTF(PAT,ARY) ;a query for Treating Facility.
+1 ;INPUT PAT - The patient's ICN
+2 ; ARY - The array in which to return the Treating facility info.
+3 ;OUTPUT A list of the Treating Facilities in the array provided from
+4 ; the parameter. It will be in the structure of x(1), x(2) etc.
+5 ; Ex X(1)=<ID> ^ <ID TYPE> ^ <Assigning Authority> ^ <Assigning Facility> ^ <ID Status>
+6 ;
+7 ; This is also a function call. If there is an error then "1^error description" will be returned.
+8 ; If no data is found the array will not be populated and "1^error description" will be returned.
+9 ;
+10 NEW PDFN,HMPER,LP,CTR
+11 ;
+12 ; ICN is not required
+13 IF ('$DATA(ARY))
SET HMPER="1^Parameter missing."
GOTO QUERYTFQ
+14 SET HMPER=0
SET CTR=1
+15 SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
IF '$TEST
GOTO QUERYTFQ
+16 SET PDFN=$GET(DFN)
+17 IF '$GET(PDFN)
SET HMPER="1^DFN is not defined."
GOTO QUERYTFQ
+18 ;SET FIRST ENTRY TO BE THE ICN - FULL ICN - PAT IS NOT THE ICN
+19 SET @ARY@(CTR)=$$GETICN^MPIF001(PDFN)_"^NI^200M^USVHA^A"
+20 ;**856 - MVI 1371 (ckn)
+21 ;Loop through all TFIENs for site
+22 ;F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:'LP S TFIEN=$O(^(LP,"")) D SET(TFIEN,ARY,.CTR)
+23 FOR LP=0:0
SET LP=$ORDER(^DGCN(391.91,"APAT",PDFN,LP))
if 'LP
QUIT
Begin DoDot:1
+24 SET TFIEN=0
FOR
SET TFIEN=$ORDER(^DGCN(391.91,"APAT",PDFN,LP,TFIEN))
if 'TFIEN
QUIT
Begin DoDot:2
+25 DO SET(TFIEN,ARY,.CTR)
End DoDot:2
End DoDot:1
+26 IF $DATA(@ARY)'>9
SET HMPER="1^Could not find Treating Facilities"
QUERYTFQ QUIT HMPER
+1 ;
SET(TFIEN,ARY,CTR) ;This sets the array with the treating facility list.
+1 ; Ex ARY(1)=<ID> ^ <ID TYPE> ^ <Assigning Facility> ^ <Assigning Authority> ^ <ID Status>
+2 NEW DGCN,INSTIEN,SOURCE,EN,SDFN,STATUS,SITEN,ID,IDTYPE,SITE,ASSAUTH,FOUND,NODE,NODE0,NODE2,STNNUM
+3 SET DGCN(0)=$GET(^DGCN(391.91,TFIEN,0))
SET SITEN=""
+4 ;
+5 ; TREATING FACILITY LIST (#391.91) INSTITUTION field (#.02)
SET INSTIEN=$PIECE($GET(DGCN(0)),"^",2)
+6 ; STATION from Institution IEN
IF INSTIEN'=""
SET SITEN=$$STA^XUAF4(INSTIEN)
+7 ; ID=Patient DFN field (#.01)
SET ID=$PIECE(DGCN(0),"^")
+8 SET STNNUM=SITEN
+9 ;
+10 SET NODE2=$GET(^DGCN(391.91,TFIEN,2))
+11 ; SDFN="SOURCE ID"
SET SDFN=$PIECE(NODE2,"^",2)
+12 ; STATUS="IDENTIFIER STATUS"
SET STATUS=$PIECE(NODE2,"^",3)
+13 ; Assigning Authority
SET ASSAUTH=$PIECE(NODE2,"^")
+14 ;
+15 SET NODE0=$GET(^DGCN(391.91,TFIEN,0))
+16 ; SOURCE ID TYPE
SET IDTYPE=$PIECE(NODE0,"^",9)
+17 ;
+18 IF SITEN="200DOD"!(SITEN["200N")
SET IDTYPE="NI"
+19 IF SITEN="200DOD"
SET ASSAUTH="USDOD"
+20 IF IDTYPE=""
SET IDTYPE="PI"
+21 IF ASSAUTH=""
SET ASSAUTH="USVHA"
+22 IF SITEN["200N"&(IDTYPE="NI")&(ASSAUTH="USVHA")
SET ASSAUTH=""
+23 IF IDTYPE="PI"
SET SITEN=$$TF2SITEN(TFIEN)
if (SITEN=""&(STNNUM'="742V1"))
QUIT
+24 ;
+25 ; If VA Internal Patient ID, get site hash from domain associated with Treating Facility
+26 SET NODE0=$GET(^DGCN(391.91,TFIEN,0))
+27 SET NODE2=$GET(^DGCN(391.91,TFIEN,2))
+28 SET SDFN=$PIECE(NODE2,"^",2)
SET STATUS=$PIECE(NODE2,"^",3)
SET IDTYPE=$PIECE(NODE0,"^",9)
+29 ; DE2345 - MBS 9/15/2015; Only return active entries
+30 IF STATUS'="A"
QUIT
+31 SET ASSAUTH=$PIECE(NODE2,"^")
+32 IF SITEN="200DOD"!(SITEN["200N")
SET IDTYPE="NI"
+33 IF SITEN="200DOD"
SET ASSAUTH="USDOD"
+34 IF IDTYPE=""
SET IDTYPE="PI"
+35 IF ASSAUTH=""
SET ASSAUTH="USVHA"
+36 IF SITEN["200N"&(IDTYPE="NI")&(ASSAUTH="USVHA")
SET ASSAUTH=""
+37 IF SDFN'=""
SET CTR=CTR+1
SET @ARY@(CTR)=SDFN_"^"_IDTYPE_"^"_SITEN_"^"_ASSAUTH_"^"_STATUS_"^"_STNNUM
SET FOUND=1
+38 QUIT
TF2SITEN(TFIEN) ;Find the DOMAIN associated with the TREATING FACILITY and return the station number.
+1 ;Currently, our test systems' station numbers are not set up for local DOMAINs. This would result in these
+2 ;entries failing all the time, thus breaking existing behavior. For the time being, we will default to
+3 ;the old behavior if we cannot locate a station number as a temporary measure. In the future, we need to
+4 ;fix the test systems to set up the station numbers correctly, and then change this code to return
+5 ;an empty string if the DOMAIN could not be resolved.
+6 SET SITEN=""
+7 if '+$GET(TFIEN)
QUIT ""
+8 if '$DATA(^DGCN(391.91,TFIEN))
QUIT ""
+9 ;Get station number from Institution file (pointed to from Treating Facility List)
+10 NEW INSTNUM,STNNUM,DONE,I
+11 SET INSTNUM=$PIECE($GET(^DGCN(391.91,TFIEN,0)),U,2)
if '+INSTNUM
QUIT SITEN
+12 ;ICR 2056
SET STNNUM=$$GET1^DIQ(4,INSTNUM_",",99)
+13 if '+STNNUM
QUIT SITEN
+14 ;DE2345 - MBS 9/15/2015; Do not return entries with station numbers=+200
+15 IF STNNUM?1"200".A
QUIT ""
+16 ;Domain file doesn't have an x-ref on station number, so we have to brute-force it
+17 SET (I,DONE)=0
FOR
SET I=$ORDER(^DIC(4.2,I))
if '+I
QUIT
Begin DoDot:1
+18 IF $PIECE(^DIC(4.2,I,0),U,13)=STNNUM
SET SITEN=$$SYS^HMPUTILS($PIECE(^DIC(4.2,I,0),U))
SET DONE=1
End DoDot:1
if DONE
QUIT
+19 QUIT SITEN
+20 ;
