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

HMPTFU2.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; DIQ 2056 ;DE6363 - JD - 8/23/16
  1. ;
  1. ; Reference to ^DGCN(391.91 is NOT currently supported; see ICR #2911 for an existing Private ICR between
  1. ; Registration and CIRN that would meet the needs of this routine, or provide an example for a new ICR.
  1. ;
  1. Q
  1. ;
  1. 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
  1. ; PT values : Source ID^Source ID Type^Assigning Authority^Assigning Facility
  1. ; ICN example: 1008520438V882204^NI^USVHA^200M
  1. ; DFN example: 100000511^PI^USVHA^500
  1. ; EDIPI example: 852043888^NI^USDOD^200DOD
  1. ;
  1. ; SOURCE ID: SOURCE ID is the unique system assigned identifier at the identified facility for the
  1. ; patient record. The value of SOURCE ID varies, depending on the source facility.
  1. ; If SOURCE ID is from the Master Patient Index, the value is the Integration
  1. ; Control Number (ICN). If SOURCE ID is from the Department of Defense (DOD), the
  1. ; value is the Electronic Data Interchange Personal Identifier (EDIPI), which is
  1. ; their equivalent of an ICN. In the future, SOURCE ID may come from other sources
  1. ; due to additional initiatives.
  1. ;
  1. ; SOURCE ID TYPE: SOURCE ID TYPE defines the data source for the TREATING FACILITY LIST file (#391.91) entry.
  1. ; The source ID type is a reference to the HL7 Table 0203, Identifier Type, and the VA
  1. ; Identity Management user defined values: NI (National Identifier), PI (Patient Identifier)
  1. ;
  1. ; Return:
  1. ; This will return the ICN and the list of treating facilities in the following format:
  1. ; RESULT(n)=Id^IdType^AssigningFacility^AssigningAuthority^IdStatus
  1. ; Examples:
  1. ; RESULT(1)="1011232151V598646^NI^200M^A"
  1. ; RESULT(2)="7168937^PI^91E3^USVHA^A"
  1. ; RESULT(3)="852043888^NI^200DOD^USDOD^A"
  1. ;
  1. ; ID STATUS: ID STATUS supports joint VA/DoD medical centers, Veteran's Record Management (VRM), and Virtual
  1. ; Lifetime Electronic Record (VLER) initiatives. This field allows the capture of resolved
  1. ; duplicate events and exposes the related identifier and identifier status to the consuming
  1. ; applications. A value of ""A"" indicates that the patient record is an active record on
  1. ; the identifying system (e.g., VAMC or DoD). A value of "H" indicates that the patient
  1. ; record was identified as part of a duplicate pair, has been merged, and is no longer active
  1. ; on the identifying system (e.g., VAMC or DoD).
  1. ;
  1. N X,ICN,DFN,EDIPI,ASSIGN,ID,SITE,TYPE,SITEIEN,TFIEN
  1. ;
  1. ; Master Patient Index (MPI) must be installed to continue
  1. S X="MPIF001" X ^%ZOSF("TEST") I '$T S LIST(1)="-1^MPI Not Installed" Q
  1. ;
  1. K LIST ; Clear "return" variable
  1. ;
  1. ; what do we have
  1. S TYPE=$P(PT,"^",2) ; SOURCE ID TYPE
  1. S SITE=$P(PT,"^",4) ;
  1. S ID=$P(PT,"^")
  1. S ASSIGN=$P(PT,"^",3)
  1. ; check input data
  1. I ID']"" S LIST(1)="-1^Id is not defined." Q
  1. I TYPE'="NI",TYPE'="PI" S LIST(1)="-1^Invalid Id Type." Q
  1. I ASSIGN'="USVHA",ASSIGN'="USDOD" S LIST(1)="-1^Invalid Assigning Authority." Q
  1. I SITE']"" S LIST(1)="-1^Missing Assigning Facility." Q
  1. ; find the ien for the station number
  1. S SITEIEN=$$FIND1^DIC(4,"","X",SITE,"D")
  1. I 'SITEIEN S LIST(1)="-1^Assigning Facility is not defined in database." Q
  1. I TYPE="PI",ASSIGN="USVHA" S DFN=ID
  1. I TYPE="NI",ASSIGN="USVHA",SITE="200M" S ICN=ID
  1. I TYPE="NI",ASSIGN="USDOD",SITE="200DOD" S EDIPI=ID
  1. I $D(ICN) S DFN=$$GETDFN^MPIF001(ICN) D Q:$D(LIST(1))
  1. . I +DFN<0 S LIST(1)="-1^ICN is not known" Q
  1. . S SITEIEN=$$IEN^XUAF4($P($$SITE^VASITE,"^",3))
  1. ;
  1. I $D(DFN) S ICN=$$GETICN^MPIF001(DFN)
  1. ; DFN should be defined, but ICN may not.
  1. ;Use new xref AISS appropriately to retrieve DFN from EDIPI
  1. I $D(EDIPI)=""!(ASSIGN="")!(TYPE="")!(SITEIEN="") S LIST(1)="-1^Insufficient data" Q
  1. I $D(EDIPI),'$D(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN)) D Q
  1. . S LIST(1)="-1^EDIPI Record is unknown at this facility"
  1. I $D(EDIPI),$D(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN)) D
  1. .S EN=$O(^DGCN(391.91,"AISS",EDIPI,ASSIGN,TYPE,SITEIEN,0))
  1. .S DFN=$P($G(^DGCN(391.91,EN,0)),"^")
  1. ;
  1. ; if ICN is not defined, it is OK, but DFN should be defined
  1. ; bad input, such as Id^NI^USVHA^123
  1. I '$G(DFN) S LIST(1)="-1^Invalid input" Q
  1. ; check DFN and Site to be matching an entry in file #391.91
  1. I '$O(^DGCN(391.91,"APAT",DFN,SITEIEN,0)) D Q
  1. . S LIST(1)="-1^Id as '"_ID_"'"_" is not in database"
  1. ; DFN should be defined, but ICN may not.
  1. S X=$$QUERYTF($P($G(ICN),"V"),"LIST")
  1. I $P(X,U)="1" S LIST(1)="-1"_U_$P(X,U,2) Q
  1. Q
  1. ;
  1. GETICN(EDIPI) ;return the ICN when EDIPI is passed
  1. N EN,DFN,ICN,IEN
  1. S IEN=$$IEN^XUAF4("200DOD")
  1. I 'IEN Q "-1^Unknown Assigning Facility."
  1. I '$D(^DGCN(391.91,"ASCR",EDIPI,IEN)) Q "-1^EDIPI Record is unknown at this facility"
  1. I $D(^DGCN(391.91,"ASCR",EDIPI,IEN)) D
  1. .S EN=$O(^DGCN(391.91,"ASCR",EDIPI,$$IEN^XUAF4("200DOD"),""))
  1. .S DFN=$P($G(^DGCN(391.91,EN,0)),"^")
  1. .I DFN'="" S ICN=$$GETICN^MPIF001(DFN)
  1. .I DFN="" S ICN="-1^No Site Record associated with this entry"
  1. Q ICN
  1. ;
  1. QUERYTF(PAT,ARY) ;a query for Treating Facility.
  1. ;INPUT PAT - The patient's ICN
  1. ; ARY - The array in which to return the Treating facility info.
  1. ;OUTPUT A list of the Treating Facilities in the array provided from
  1. ; the parameter. It will be in the structure of x(1), x(2) etc.
  1. ; Ex X(1)=<ID> ^ <ID TYPE> ^ <Assigning Authority> ^ <Assigning Facility> ^ <ID Status>
  1. ;
  1. ; This is also a function call. If there is an error then "1^error description" will be returned.
  1. ; If no data is found the array will not be populated and "1^error description" will be returned.
  1. ;
  1. N PDFN,HMPER,LP,CTR
  1. ;
  1. ; ICN is not required
  1. I ('$D(ARY)) S HMPER="1^Parameter missing." G QUERYTFQ
  1. S HMPER=0,CTR=1
  1. S X="MPIF001" X ^%ZOSF("TEST") I '$T G QUERYTFQ
  1. S PDFN=$G(DFN)
  1. I '$G(PDFN) S HMPER="1^DFN is not defined." G QUERYTFQ
  1. ;SET FIRST ENTRY TO BE THE ICN - FULL ICN - PAT IS NOT THE ICN
  1. S @ARY@(CTR)=$$GETICN^MPIF001(PDFN)_"^NI^200M^USVHA^A"
  1. ;**856 - MVI 1371 (ckn)
  1. ;Loop through all TFIENs for site
  1. ;F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:'LP S TFIEN=$O(^(LP,"")) D SET(TFIEN,ARY,.CTR)
  1. F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:'LP D
  1. .S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,TFIEN)) Q:'TFIEN D
  1. ..D SET(TFIEN,ARY,.CTR)
  1. I $D(@ARY)'>9 S HMPER="1^Could not find Treating Facilities"
  1. QUERYTFQ Q HMPER
  1. ;
  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>
  1. N DGCN,INSTIEN,SOURCE,EN,SDFN,STATUS,SITEN,ID,IDTYPE,SITE,ASSAUTH,FOUND,NODE,NODE0,NODE2,STNNUM
  1. S DGCN(0)=$G(^DGCN(391.91,TFIEN,0)),SITEN=""
  1. ;
  1. S INSTIEN=$P($G(DGCN(0)),"^",2) ; TREATING FACILITY LIST (#391.91) INSTITUTION field (#.02)
  1. I INSTIEN'="" S SITEN=$$STA^XUAF4(INSTIEN) ; STATION from Institution IEN
  1. S ID=$P(DGCN(0),"^") ; ID=Patient DFN field (#.01)
  1. S STNNUM=SITEN
  1. ;
  1. S NODE2=$G(^DGCN(391.91,TFIEN,2))
  1. S SDFN=$P(NODE2,"^",2) ; SDFN="SOURCE ID"
  1. S STATUS=$P(NODE2,"^",3) ; STATUS="IDENTIFIER STATUS"
  1. S ASSAUTH=$P(NODE2,"^") ; Assigning Authority
  1. ;
  1. S NODE0=$G(^DGCN(391.91,TFIEN,0))
  1. S IDTYPE=$P(NODE0,"^",9) ; SOURCE ID TYPE
  1. ;
  1. I SITEN="200DOD"!(SITEN["200N") S IDTYPE="NI"
  1. I SITEN="200DOD" S ASSAUTH="USDOD"
  1. I IDTYPE="" S IDTYPE="PI"
  1. I ASSAUTH="" S ASSAUTH="USVHA"
  1. I SITEN["200N"&(IDTYPE="NI")&(ASSAUTH="USVHA") S ASSAUTH=""
  1. I IDTYPE="PI" S SITEN=$$TF2SITEN(TFIEN) Q:(SITEN=""&(STNNUM'="742V1"))
  1. ;
  1. ; If VA Internal Patient ID, get site hash from domain associated with Treating Facility
  1. S NODE0=$G(^DGCN(391.91,TFIEN,0))
  1. S NODE2=$G(^DGCN(391.91,TFIEN,2))
  1. S SDFN=$P(NODE2,"^",2),STATUS=$P(NODE2,"^",3),IDTYPE=$P(NODE0,"^",9)
  1. ; DE2345 - MBS 9/15/2015; Only return active entries
  1. I STATUS'="A" Q
  1. S ASSAUTH=$P(NODE2,"^")
  1. I SITEN="200DOD"!(SITEN["200N") S IDTYPE="NI"
  1. I SITEN="200DOD" S ASSAUTH="USDOD"
  1. I IDTYPE="" S IDTYPE="PI"
  1. I ASSAUTH="" S ASSAUTH="USVHA"
  1. I SITEN["200N"&(IDTYPE="NI")&(ASSAUTH="USVHA") S ASSAUTH=""
  1. I SDFN'="" S CTR=CTR+1,@ARY@(CTR)=SDFN_"^"_IDTYPE_"^"_SITEN_"^"_ASSAUTH_"^"_STATUS_"^"_STNNUM,FOUND=1
  1. Q
  1. 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
  1. ;entries failing all the time, thus breaking existing behavior. For the time being, we will default to
  1. ;the old behavior if we cannot locate a station number as a temporary measure. In the future, we need to
  1. ;fix the test systems to set up the station numbers correctly, and then change this code to return
  1. ;an empty string if the DOMAIN could not be resolved.
  1. S SITEN=""
  1. Q:'+$G(TFIEN) ""
  1. Q:'$D(^DGCN(391.91,TFIEN)) ""
  1. ;Get station number from Institution file (pointed to from Treating Facility List)
  1. N INSTNUM,STNNUM,DONE,I
  1. S INSTNUM=$P($G(^DGCN(391.91,TFIEN,0)),U,2) Q:'+INSTNUM SITEN
  1. S STNNUM=$$GET1^DIQ(4,INSTNUM_",",99) ;ICR 2056
  1. Q:'+STNNUM SITEN
  1. ;DE2345 - MBS 9/15/2015; Do not return entries with station numbers=+200
  1. I STNNUM?1"200".A Q ""
  1. ;Domain file doesn't have an x-ref on station number, so we have to brute-force it
  1. S (I,DONE)=0 F S I=$O(^DIC(4.2,I)) Q:'+I D Q:DONE
  1. . I $P(^DIC(4.2,I,0),U,13)=STNNUM S SITEN=$$SYS^HMPUTILS($P(^DIC(4.2,I,0),U)),DONE=1
  1. Q SITEN
  1. ;