source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGROUT.m@ 1424

Last change on this file since 1424 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1DGROUT ;DJH/AMA - ROM UTILITIES ; 28 Apr 2004 12:24 PM
2 ;;5.3;Registration;**533,572**;Aug 13, 1993
3 ;
4 Q ;no direct entry
5 ;
6MPIOK(DGDFN,DGICN,DGLST) ;return non-local LST and ICN
7 ;This function retrieves an ICN given a pointer to the PATIENT (#2)
8 ;file for a patient. When the ICN is not local and the local site
9 ;is not the Last Site Treated (LST), the LST is retrieved as a
10 ;pointer to the INSTITUTION (#4) file.
11 ; Called from SNDQRY^DGROHLR
12 ;
13 ; Supported DBIA #2701: The supported DBIA is used to access MPI
14 ; APIs to retrieve ICN, determine if ICN
15 ; is local and if site is LST.
16 ; Supported DBIA #2702: The supported DBIA is used to retrieve the
17 ; MPI node from the PATIENT (#2) file.
18 ;
19 ; Input:
20 ; DGDFN - IEN of patient in PATIENT (#2) file
21 ; DGICN - passed by reference to contain national ICN
22 ; DGLST - passed by reference to contain LST
23 ;
24 ; Output:
25 ; Function Value - 1 on national ICN and non-local LST, 0 on failure
26 ; DGICN - Patient's Integrated Control Number
27 ; DGLST - Pointer to INSTITUTION (#4) file for LST if LST
28 ; is not local, undefined otherwise.
29 ;
30 N DGRSLT
31 S DGRSLT=0
32 I $G(DGDFN)>0,$D(^DPT(DGDFN,"MPI")) D
33 . S DGICN=$$GETICN^MPIF001(DGDFN)
34 . ;
35 . ;ICN must be valid
36 . I (DGICN'>0) D Q
37 . . S DGMSG(1)=" "
38 . . S DGMSG(2)="The query to the LST has been terminated because required"
39 . . S DGMSG(3)="information was not provided by the MPI."
40 . . D EN^DDIOL(.DGMSG) R A:5
41 . ;
42 . ;ICN must not be local
43 . I $$IFLOCAL^MPIF001(DGDFN) D Q
44 . . S DGMSG(1)=" "
45 . . S DGMSG(2)="The query to the LST has been terminated because required"
46 . . S DGMSG(3)="information was not provided by the MPI."
47 . . D EN^DDIOL(.DGMSG) R A:5
48 . ;
49 . ;Get LST from Treating Facility List
50 . S DGLST=$$TFL(DGDFN)
51 . ;
52 . I (DGLST'>0) D Q
53 . . S DGMSG(1)=" "
54 . . S DGMSG(2)="The query to the LST has been terminated because required"
55 . . S DGMSG(3)="information was not provided by the MPI."
56 . . D EN^DDIOL(.DGMSG) R A:5
57 . ;
58 . S DGRSLT=1
59 Q DGRSLT
60 ;
61TFL(DFN) ;
62 ;Retrieve Last Site Treated from the Treating Facility List ^DGCN(391.91
63 ;This function will retrieve the most recent treatment site
64 ;from the Treating Facility List (TFL) received from the MPI
65 ;
66 ; Input:
67 ; DFN - (required) IEN of patient in PATIENT (#2) File
68 ;
69 ; Output:
70 ; Function value - Facility IEN on success, 0 on failure
71 ;
72 N RSLT ;Result returned from call
73 N QFL ;Quit flag
74 N TFLDR ;Treating Facility List Record Number
75 N DATA ;Array of TFL data
76 N RDATA ;Array of Treating Facilities arranged by date and TFLDR
77 N DATE,TFL
78 ;
79 S (RSLT,QFL)=0
80 ;Check to see if there is a TFL for this patient.
81 ;If not exit and return -1 to call.
82 I '$D(^DGCN(391.91,"B",DFN)) G EXITTFL
83 ;
84 ;Go through the "B" index of TFL file and retrieve
85 ;record numbers for the patient DFN.
86 S TFLDR="" F S TFLDR=$O(^DGCN(391.91,"B",DFN,TFLDR)) Q:TFLDR="" D
87 . ;Retrieve data from record and store in DATA array by record number.
88 . S DATA(TFLDR)=$G(^DGCN(391.91,TFLDR,0))
89 . ;Extract DATE from 3rd piece of record
90 . S DATE=$P(DATA(TFLDR),"^",3)
91 . ;Quit if DATE is null
92 . Q:DATE=""
93 . ;Get Station Number using the facility pointer to the Institution (#4) file
94 . S FAC=$P(DATA(TFLDR),"^",2)
95 . S FAC=$$STA^XUAF4(FAC) Q:FAC=""
96 . ;Build RDATA array using the DATE and TFLDR
97 . S RDATA(DATE,TFLDR)=FAC
98 ;Exit if the RDATA array does not exist.
99 G:'$D(RDATA) EXITTFL
100 ;
101 ;Reverse order through the RDATA array (start with the latest date).
102 ;Extract the treating facility from the RDATA array.
103 ;Check the facility against local facility number: if they are
104 ;the same, then get the next facility. (Should never happen)
105 S DATE="" F S DATE=$O(RDATA(DATE),-1) Q:DATE="" D Q:QFL=1
106 . S TFL="" F S TFL=$O(RDATA(DATE,TFL)) Q:TFL="" D Q:QFL=1
107 . . S FAC=RDATA(DATE,TFL) I FAC=$G(DIV(0)) Q
108 . . ;If the facility is not the current facility, then set RSLT to the facility and quit
109 . . S RSLT=FAC,QFL=1 ;set QFL to 1 to stop going through the RDATA array
110EXITTFL Q RSLT ;Return the LST to the calling routine
Note: See TracBrowser for help on using the repository browser.