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

VAFCTFU1.m

Go to the documentation of this file.
  1. VAFCTFU1 ;BHM/RGY-Utilities for the Treating Facility file 391.91, CONTINUED ;6 May 2021 1:56 PM
  1. ;;5.3;Registration;**261,392,448,449,800,856,1042,1055**;Aug 13, 1993;Build 1
  1. TFL(LIST,DFN) ;for dfn get list of treating facilities
  1. NEW X,ICN,DA,DR,VAFCTFU1,DIC,DIQ,VAFC
  1. S X="MPIF001" X ^%ZOSF("TEST") I '$T S LIST(1)="-1^MPI Not Installed" Q
  1. S DR=".01;13;99",DIC=4,DIQ(0)="E",DIQ="VAFCTFU1" ;**448
  1. S ICN=$$GETICN^MPIF001(DFN)
  1. I ICN<0 S LIST(1)=ICN Q
  1. S X=$$QUERYTF($P(ICN,"V"),"LIST",0)
  1. I $P(X,U)="1" S LIST(1)="-1"_U_$P(X,U,2) Q
  1. F VAFC=0:0 S VAFC=$O(LIST(VAFC)) Q:VAFC="" D
  1. .K VAFCTFU1
  1. .S DA=+LIST(VAFC)
  1. .D EN^DIQ1
  1. .S LIST(VAFC)=VAFCTFU1(4,+LIST(VAFC),99,"E")_"^"_VAFCTFU1(4,+LIST(VAFC),.01,"E")_"^"_$P(LIST(VAFC),"^",2)_"^"_$P(LIST(VAFC),"^",3)_"^"_VAFCTFU1(4,+LIST(VAFC),13,"E") ;**448
  1. .Q
  1. Q
  1. GETICN(RESULT,DFN) ;
  1. S RESULT=$$GETICN^MPIF001(DFN)
  1. Q
  1. GETDFN(RESULT,ICN) ;
  1. S RESULT=$$GETDFN^MPIF001(ICN)
  1. Q
  1. IFLOCAL(RESULT,DFN) ;
  1. S RESULT=$$IFLOCAL^MPIF001(DFN)
  1. Q
  1. ;
  1. SET(TFIEN,ARY,CTR) ;This sets the array with the treating facility list.
  1. ; Returns: treating facility ^ treatment date ^ event reason (if any)
  1. ; *261 gjc@120899 (formerly part of VAFCTFU prior to DG*5.3*261)
  1. N DGCN,INSTIEN,LSTA S DGCN(0)=$G(^DGCN(391.91,TFIEN,0))
  1. ;** DG*5.3*800 - (ckn) - Quit if IPP field is not set for 200MH record
  1. S INSTIEN=$P($G(DGCN(0)),"^",2),LSTA=$$STA^XUAF4(INSTIEN)
  1. I $E(LSTA,1,5)="200MH",$P($G(DGCN(0)),"^",8)'=1 Q
  1. S CTR=CTR+1,@ARY@(CTR)=$P(DGCN(0),U,2,3)_U_$P(DGCN(0),U,7)
  1. Q
  1. ;
  1. QUERYTF(PAT,ARY,INDX) ;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. ; INDX (optional) - the index to $O through. APAT for patient
  1. ; information linked to treating facilities, AEVN for patient
  1. ; info linked with an event reason. INDX=1 if AEVN is used,
  1. ; else APAT is used. *261 gjc@120399
  1. ;
  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)=500^2960101^ptr to ADT/HL7 Event Reason file (if exists)
  1. ; Where the first piece is the IEN of the institution, the second
  1. ; piece is the current date on record for that institution and the
  1. ; third piece is the event reason (if it exists). Note: A04 & A08
  1. ; events do not file an event reason when adding to the TREATING
  1. ; FACILITY LIST (#391.91) file, thus returning null in the third
  1. ; piece. *261 gjc@120199
  1. ;
  1. ; This is also a function call. If there is an error then a
  1. ; 1^error description will be returned.
  1. ;
  1. ; *** If no data is found the array will not be populated and
  1. ; a 1^error description will be returned.
  1. ;
  1. N PDFN,VAFCER,LP,CTR,ZTFIEN,ZDLT,ZTDLT
  1. I '$G(PAT)!('$D(ARY)) S VAFCER="1^Parameter missing." G QUERYTFQ
  1. S VAFCER=0,CTR=0,INDX=$G(INDX)
  1. S X="MPIF001" X ^%ZOSF("TEST") I '$T G QUERYTFQ
  1. S PDFN=$$GETDFN^MPIF001(PAT)
  1. I PDFN<0 S VAFCER="1^No patient DFN." G QUERYTFQ
  1. ; determine the index to $O through, based on the value of INDX
  1. ;I 'INDX 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. ;**856 - MVI 1371 (ckn)
  1. ;Now that Treating Facility file can have multiple entries for
  1. ;one site, enhanced the code to loop through all TFIENs for each SITE
  1. ;and return the record which have latest Date Last Treated. If none
  1. ;of the entries have DLT populated, return the first record for site.
  1. I 'INDX F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:'LP D
  1. .Q:'$$ISVAMC(LP) ;**1042,VAMPI-8212 (mko): Skip non-VAMCs
  1. .S ZTDLT=0,ZTFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,"")) Q:'ZTFIEN
  1. .S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,TFIEN)) Q:'TFIEN D
  1. ..Q:'$$ISPATIEN(TFIEN) ;**1042,VAMPI-8212 (mko): Skip if not a patient record (not "PI" or null)
  1. ..S ZDLT=$P(^DGCN(391.91,TFIEN,0),"^",3) ;Date last treated
  1. ..I ZDLT>ZTDLT S ZTDLT=ZDLT,ZTFIEN=TFIEN
  1. .D SET(ZTFIEN,ARY,.CTR)
  1. I INDX S LP=0 F S LP=$O(^DGCN(391.91,"AEVN",PDFN,LP)) Q:'LP D
  1. .; please note the following: the AEVN xref is subscripted by pat. dfn
  1. .; event reason ptr, and the ien of the TFL file. It is possible
  1. .; that a patient may have numerous admission/discharges at different
  1. .; treating facilities, thus the looping through the TFIEN (TFL ien)
  1. .; subscript. *261 gjc@120399
  1. .S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"AEVN",PDFN,LP,TFIEN)) Q:'TFIEN D SET(TFIEN,ARY,.CTR)
  1. .Q
  1. I $D(@ARY)'>9 S VAFCER="1^Could not find Treating Facilities"
  1. QUERYTFQ Q VAFCER
  1. ;
  1. ISVAMC(SITEIEN,SITEID) ;Return 1 if this is a VAMC
  1. ;**1042,VAMPI-8212 (mko): New function
  1. N DIERR,MSG
  1. I $G(SITEIEN)="" Q:$G(SITEID)="" "" S SITEIEN=$$IEN^XUAF4(SITEID)
  1. I $G(SITEID)="" S SITEID=$$STA^XUAF4(SITEIEN)
  1. ;**1055,VAMPI-10191 (mko): Allow return of 200, 200CH, and 200MH
  1. I "^200CH^200MH^"[(U_SITEID_U) Q 1
  1. I $$GET1^DIQ(4,SITEIEN_",",13,"","","MSG")'="OTHER",SITEID'="200M" Q 1
  1. Q 0
  1. ;
  1. ISPATIEN(TFLIEN) ;Return 1 if Source ID Type is "PI" or null
  1. ;**1042,VAMPI-8212 (mko): New function
  1. Q:$D(^DGCN(391.91,+$G(TFLIEN),0))[0 0
  1. Q "PI"[$P(^DGCN(391.91,+$G(TFLIEN),0),"^",9)