- 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 Feb 18, 2025@23:20:58 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 ;