source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCTFU1.m@ 724

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1VAFCTFU1 ;BHM/RGY-Utilities for the Treating Facility file 391.91, CONTINUED ;10/31/99
2 ;;5.3;Registration;**261,392,448,449**;Aug 13, 1993
3TFL(LIST,DFN) ;for dfn get list of treating facilities
4 NEW X,ICN,DA,DR,VAFCTFU1,DIC,DIQ,VAFC
5 S X="MPIF001" X ^%ZOSF("TEST") I '$T S LIST(1)="-1^MPI Not Installed" Q
6 S DR=".01;13;99",DIC=4,DIQ(0)="E",DIQ="VAFCTFU1" ;**448
7 S ICN=$$GETICN^MPIF001(DFN)
8 I ICN<0 S LIST(1)=ICN Q
9 S X=$$QUERYTF($P(ICN,"V"),"LIST",0)
10 I $P(X,U)="1" S LIST(1)="-1"_U_$P(X,U,2) Q
11 F VAFC=0:0 S VAFC=$O(LIST(VAFC)) Q:VAFC="" D
12 .K VAFCTFU1
13 .S DA=+LIST(VAFC)
14 .D EN^DIQ1
15 .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
16 .Q
17 Q
18GETICN(RESULT,DFN) ;
19 S RESULT=$$GETICN^MPIF001(DFN)
20 Q
21GETDFN(RESULT,ICN) ;
22 S RESULT=$$GETDFN^MPIF001(ICN)
23 Q
24IFLOCAL(RESULT,DFN) ;
25 S RESULT=$$IFLOCAL^MPIF001(DFN)
26 Q
27 ;
28SET(TFIEN,ARY,CTR) ;This sets the array with the treating facility list.
29 ; Returns: treating facility ^ treatment date ^ event reason (if any)
30 ; *261 gjc@120899 (formerly part of VAFCTFU prior to DG*5.3*261)
31 N DGCN S CTR=CTR+1,DGCN(0)=$G(^DGCN(391.91,TFIEN,0))
32 S @ARY@(CTR)=$P(DGCN(0),U,2,3)_U_$P(DGCN(0),U,7)
33 Q
34 ;
35QUERYTF(PAT,ARY,INDX) ;a query for Treating Facility.
36 ;INPUT PAT - The patient's ICN
37 ; ARY - The array in which to return the Treating facility info.
38 ; INDX (optional) - the index to $O through. APAT for patient
39 ; information linked to treating facilities, AEVN for patient
40 ; info linked with an event reason. INDX=1 if AEVN is used,
41 ; else APAT is used. *261 gjc@120399
42 ;
43 ;OUTPUT A list of the Treating Facilities in the array provided from
44 ; the parameter. It will be in the structure of x(1), x(2) etc.
45 ; Ex X(1)=500^2960101^ptr to ADT/HL7 Event Reason file (if exists)
46 ; Where the first piece is the IEN of the institution, the second
47 ; piece is the current date on record for that institution and the
48 ; third piece is the event reason (if it exists). Note: A04 & A08
49 ; events do not file an event reason when adding to the TREATING
50 ; FACILITY LIST (#391.91) file, thus returning null in the third
51 ; piece. *261 gjc@120199
52 ;
53 ; This is also a function call. If there is an error then a
54 ; 1^error description will be returned.
55 ;
56 ; *** If no data is found the array will not be populated and
57 ; a 1^error description will be returned.
58 ;
59 N PDFN,VAFCER,LP,CTR
60 I '$G(PAT)!('$D(ARY)) S VAFCER="1^Parameter missing." G QUERYTFQ
61 S VAFCER=0,CTR=0,INDX=$G(INDX)
62 S X="MPIF001" X ^%ZOSF("TEST") I '$T G QUERYTFQ
63 S PDFN=$$GETDFN^MPIF001(PAT)
64 I PDFN<0 S VAFCER="1^No patient DFN." G QUERYTFQ
65 ; determine the index to $O through, based on the value of INDX
66 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)
67 I INDX S LP=0 F S LP=$O(^DGCN(391.91,"AEVN",PDFN,LP)) Q:'LP D
68 .; please note the following: the AEVN xref is subscripted by pat. dfn
69 .; event reason ptr, and the ien of the TFL file. It is possible
70 .; that a patient may have numerous admission/discharges at different
71 .; treating facilities, thus the looping through the TFIEN (TFL ien)
72 .; subscript. *261 gjc@120399
73 .S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"AEVN",PDFN,LP,TFIEN)) Q:'TFIEN D SET(TFIEN,ARY,.CTR)
74 .Q
75 I $D(@ARY)'>9 S VAFCER="1^Could not find Treating Facilities"
76QUERYTFQ Q VAFCER
Note: See TracBrowser for help on using the repository browser.