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

DGROUT.m

Go to the documentation of this file. 
  1. DGROUT ;DJH/AMA - ROM UTILITIES ; 28 Apr 2004  12:24 PM
  1.  ;;5.3;Registration;**533,572,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  Q   ;no direct entry
  1.  ;
  1. MPIOK(DGDFN,DGICN,DGLST) ;return non-local LST and ICN
  1.  ;This function retrieves an ICN given a pointer to the PATIENT (#2)
  1.  ;file for a patient.  When the ICN is not local and the local site
  1.  ;is not the Last Site Treated (LST), the LST is retrieved as a
  1.  ;pointer to the INSTITUTION (#4) file.
  1.  ;  Called from SNDQRY^DGROHLR
  1.  ;
  1.  ;  Supported DBIA #2701:  The supported DBIA is used to access MPI
  1.  ;                         APIs to retrieve ICN, determine if ICN
  1.  ;                         is local and if site is LST.
  1.  ;  Supported DBIA #2702:  The supported DBIA is used to retrieve the
  1.  ;                         MPI node from the PATIENT (#2) file.
  1.  ;
  1.  ;  Input:
  1.  ;    DGDFN - IEN of patient in PATIENT (#2) file
  1.  ;    DGICN - passed by reference to contain national ICN
  1.  ;    DGLST - passed by reference to contain LST
  1.  ;
  1.  ;  Output:
  1.  ;   Function Value - 1 on national ICN and non-local LST, 0 on failure
  1.  ;            DGICN - Patient's Integrated Control Number
  1.  ;            DGLST - Pointer to INSTITUTION (#4) file for LST if LST
  1.  ;                    is not local, undefined otherwise.
  1.  ;
  1.  N DGRSLT
  1.  S DGRSLT=0
  1.  I $G(DGDFN)>0,$D(^DPT(DGDFN,"MPI")) D
  1.  . S DGICN=$$GETICN^MPIF001(DGDFN)
  1.  . ;
  1.  . ;ICN must be valid
  1.  . I (DGICN'>0) D  Q
  1.  . . S DGMSG(1)=" "
  1.  . . S DGMSG(2)="The query to the LST has been terminated because required"
  1.  . . S DGMSG(3)="information was not provided by the MPI."
  1.  . . D EN^DDIOL(.DGMSG) R A:5
  1.  . ;
  1.  . ;ICN must not be local
  1.  . I $$IFLOCAL^MPIF001(DGDFN) D  Q
  1.  . . S DGMSG(1)=" "
  1.  . . S DGMSG(2)="The query to the LST has been terminated because required"
  1.  . . S DGMSG(3)="information was not provided by the MPI."
  1.  . . D EN^DDIOL(.DGMSG) R A:5
  1.  . ;
  1.  . ;Get LST from Treating Facility List
  1.  . S DGLST=$$TFL(DGDFN)
  1.  . ;
  1.  . I (DGLST'>0) D  Q
  1.  . . S DGMSG(1)=" "
  1.  . . S DGMSG(2)="The query to the LST has been terminated because required"
  1.  . . S DGMSG(3)="information was not provided by the MPI."
  1.  . . D EN^DDIOL(.DGMSG) R A:5
  1.  . ;
  1.  . S DGRSLT=1
  1.  Q DGRSLT
  1.  ;
  1. TFL(DFN) ;
  1.  ;Retrieve Last Site Treated from the Treating Facility List ^DGCN(391.91
  1.  ;This function will retrieve the most recent treatment site
  1.  ;from the Treating Facility List (TFL) received from the MPI
  1.  ;
  1.  ;  Input:
  1.  ;    DFN - (required) IEN of patient in PATIENT (#2) File
  1.  ;
  1.  ;  Output:
  1.  ;    Function value - Facility IEN on success, 0 on failure
  1.  ;
  1.  N RSLT       ;Result returned from call
  1.  N QFL        ;Quit flag
  1.  N TFLDR      ;Treating Facility List Record Number
  1.  N DATA       ;Array of TFL data
  1.  N RDATA      ;Array of Treating Facilities arranged by date and TFLDR
  1.  N DATE,TFL
  1.  ;
  1.  S (RSLT,QFL)=0
  1.  ;Check to see if there is a TFL for this patient.
  1.  ;If not exit and return -1 to call.
  1.  I '$D(^DGCN(391.91,"B",DFN)) G EXITTFL
  1.  ;
  1.  ;Go through the "B" index of TFL file and retrieve
  1.  ;record numbers for the patient DFN.
  1.  S TFLDR="" F  S TFLDR=$O(^DGCN(391.91,"B",DFN,TFLDR)) Q:TFLDR=""  D
  1.  . ;Retrieve data from record and store in DATA array by record number.
  1.  . S DATA(TFLDR)=$G(^DGCN(391.91,TFLDR,0))
  1.  . ;Extract DATE from 3rd piece of record
  1.  . S DATE=$P(DATA(TFLDR),"^",3)
  1.  . ;Quit if DATE is null
  1.  . Q:DATE=""
  1.  . ;Get Station Number using the facility pointer to the Institution (#4) file
  1.  . S FAC=$P(DATA(TFLDR),"^",2)
  1.  . S FAC=$$STA^XUAF4(FAC) Q:FAC=""
  1.  . ;Build RDATA array using the DATE and TFLDR
  1.  . S RDATA(DATE,TFLDR)=FAC
  1.  ;Exit if the RDATA array does not exist.
  1.  G:'$D(RDATA) EXITTFL
  1.  ;
  1.  ;Reverse order through the RDATA array (start with the latest date).
  1.  ;Extract the treating facility from the RDATA array.
  1.  ;Check the facility against local facility number:  if they are
  1.  ;the same, then get the next facility.  (Should never happen)
  1.  S DATE="" F  S DATE=$O(RDATA(DATE),-1) Q:DATE=""  D  Q:QFL=1
  1.  . S TFL="" F  S TFL=$O(RDATA(DATE,TFL)) Q:TFL=""  D  Q:QFL=1
  1.  . . S FAC=RDATA(DATE,TFL) I FAC=$G(DIV(0)) Q
  1.  . . ;If the facility is not the current facility, then set RSLT to the facility and quit
  1.  . . S RSLT=FAC,QFL=1  ;set QFL to 1 to stop going through the RDATA array
  1. EXITTFL Q RSLT  ;Return the LST to the calling routine