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 ; 7/27/09 6:16pm
  1.  ;;5.3;PIMS;**261,392,448,449,1016**;JUN 30, 2012;Build 20
  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
  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.  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