source: FOIAVistA/tag/r/HEALTH_DATA_AND_INFORMATICS-HDI/HDISVF07.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.7 KB
Line 
1HDISVF07 ;ALB/RMO - 7118.21 File Utilities/API Cont.; 1/13/05@1:22:00
2 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
3 ;
4 ;---- Begin HDIS System file (#7118.21) API(s) ----
5 ;
6FINDSYS(HDISDIPA,HDISFACN,HDISTYPE,HDISADDF,HDISYIEN,HDISERRM) ;Find or Add a System Entry
7 ; Input -- HDISDIPA Domain/IP Address
8 ; HDISFACN Facility Number (Optional- Default current facility number)
9 ; HDISTYPE Type (Optional- Default current system)
10 ; HDISADDF Add a New Entry Flag (Optional- Default 0)
11 ; 1=Yes and 0=No
12 ; Output -- 1=Successful and 0=Failure
13 ; If Successful:
14 ; HDISYIEN HDIS System file IEN
15 ; If Failure:
16 ; HDISERRM Error Message (Optional)
17 N HDISI,HDISIPTR,HDISOKF,HDISRSLT
18 ;Initialize output
19 S (HDISYIEN,HDISERRM)=""
20 ;Check for missing variable, exit if not defined
21 I $G(HDISDIPA)="" D G FINDSYSQ
22 . S HDISERRM="Required Variable Missing."
23 ;Set Facility Number to default of current facility number, if needed
24 S HDISFACN=$S('$D(HDISFACN):$$FACNUM^HDISVF01,1:HDISFACN)
25 ;Check Facility Number, return error and exit if no value
26 I $G(HDISFACN)="" D G FINDSYSQ
27 . S HDISERRM="Unable to determine Facility Number."
28 ;Set Institution file (#4) IEN
29 S HDISIPTR=$$FACPTR^HDISVF01(HDISFACN)
30 ;Check Institution file (#4) IEN, return error and exit if no value
31 I $G(HDISIPTR)'>0 D G FINDSYSQ
32 . S HDISERRM="Unable to determine Institution file (#4) IEN."
33 ;Set Type to default of current system, if needed
34 S HDISTYPE=$S('$D(HDISTYPE):$$PROD^XUPROD,1:HDISTYPE)
35 ;Convert HDISTYPE to internal value
36 D CHK^DIE(7118.21,.03,"",HDISTYPE,.HDISRSLT)
37 S HDISTYPE=HDISRSLT
38 ;Check for existing Institution file (#4) IEN and Domain/IP Address, return entry and exit if it exists
39 I $D(^HDISF(7118.21,"B",HDISIPTR)) D G FINDSYSQ:$G(HDISYIEN)
40 . S HDISI=0
41 . F S HDISI=$O(^HDISF(7118.21,"B",HDISIPTR,HDISI)) Q:'HDISI!($G(HDISYIEN)) D
42 . . I $D(^HDISF(7118.21,HDISI,0)),$P(^(0),"^",2)=HDISDIPA D
43 . . . S HDISYIEN=HDISI
44 . . . S HDISOKF=1
45 ;If flag is set, Add a New System Entry
46 I $G(HDISADDF) S HDISOKF=$$ADDSYS(HDISIPTR,HDISDIPA,HDISTYPE,.HDISYIEN,.HDISERRM)
47 ;
48FINDSYSQ Q +$G(HDISOKF)
49 ;
50ADDSYS(HDISIPTR,HDISDIPA,HDISTYPE,HDISYIEN,HDISERRM) ;Add a New System Entry
51 ; Input -- HDISIPTR Institution file (#4) IEN
52 ; HDISDIPA Domain/IP Address
53 ; HDISTYPE Type (Internal Value)
54 ; Output -- 1=Successful and 0=Failure
55 ; If Successful:
56 ; HDISYIEN HDIS System file IEN
57 ; If Failure:
58 ; HDISERRM Error Message (Optional)
59 N HDISFDA,HDISIEN,HDISMSG,HDISOKF
60 ;Initialize output
61 S (HDISYIEN,HDISERRM)=""
62 ;Set array for Institution, Domain/IP Address and Type
63 S HDISFDA(7118.21,"+1,",.01)=$G(HDISIPTR)
64 S HDISFDA(7118.21,"+1,",.02)=$G(HDISDIPA)
65 S HDISFDA(7118.21,"+1,",.03)=$G(HDISTYPE)
66 D UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
67 ;Check for error
68 I $D(HDISMSG("DIERR")) D
69 . S HDISERRM=$G(HDISMSG("DIERR",1,"TEXT",1))
70 ELSE D
71 . S HDISYIEN=+$G(HDISIEN(1))
72 . S HDISOKF=1
73 D CLEAN^DILF
74ADDSYSQ Q +$G(HDISOKF)
75 ;
76CURSYS(HDISYIEN) ;Current System's HDIS System file IEN
77 ; Input -- None
78 ; Output -- 1=Successful and 0=Failure
79 ; If Successful:
80 ; HDISYIEN HDIS System file IEN
81 N HDISFACN,HDISIPTR,HDISTYPE
82 ;Initialize output
83 S HDISYIEN=""
84 ;Set Facility Number, Institution file (#4) IEN and Type
85 S HDISFACN=$$FACNUM^HDISVF01
86 S HDISIPTR=$$FACPTR^HDISVF01(HDISFACN)
87 S HDISTYPE=$$PROD^XUPROD
88 ;Check for entry by Type and Institution file (#4) IEN
89 S HDISYIEN=$O(^HDISF(7118.21,"ATYP",+HDISTYPE,+HDISIPTR,0))
90CURSYSQ Q +$S($G(HDISYIEN)>0:1,1:0)
91 ;
92GETFAC(HDISYIEN,HDISIPTR,HDISFACN) ;Get Institution file (#4) IEN and Facility Number by IEN
93 ; Input -- HDISYIEN HDIS System file IEN (Optional- Default current system)
94 ; Output -- 1=Successful and 0=Failure
95 ; If Successful:
96 ; HDISIPTR Institution file (#4) IEN
97 ; HDISFACN Facility Number
98 ;Initialize output
99 S (HDISIPTR,HDISFACN)=""
100 ;Set HDIS System file IEN to current system, if needed
101 I '$D(HDISYIEN),$$CURSYS(.HDISYIEN)
102 ;Check for missing variable, exit if not defined
103 I $G(HDISYIEN)'>0 G GETFACQ
104 ;Check for Institution file (#4) IEN and Facility Number by IEN
105 I $D(^HDISF(7118.21,HDISYIEN,0)) S HDISIPTR=$P($G(^(0)),"^",1) D
106 . S HDISFACN=$$FACNUM^HDISVF01(HDISIPTR)
107GETFACQ Q +$S($G(HDISIPTR)'=""&($G(HDISFACN)'=""):1,1:0)
108 ;
109GETDIP(HDISYIEN,HDISDIPA) ;Get Domain/IP Address by IEN
110 ; Input -- HDISYIEN HDIS System file IEN (Optional- Default current system)
111 ; Output -- 1=Successful and 0=Failure
112 ; If Successful:
113 ; HDISDIPA Domain/IP Address
114 ;Initialize output
115 S HDISDIPA=""
116 ;Set HDIS System file IEN to current system, if needed
117 I '$D(HDISYIEN),$$CURSYS(.HDISYIEN)
118 ;Check for missing variable, exit if not defined
119 I $G(HDISYIEN)'>0 G GETDIPQ
120 ;Check for Domain/IP Address by IEN
121 I $D(^HDISF(7118.21,HDISYIEN,0)) S HDISDIPA=$P($G(^(0)),"^",2)
122GETDIPQ Q +$S($G(HDISDIPA)'="":1,1:0)
123 ;
124 ;
125GETTYPE(HDISYIEN,HDISTYPE,HDISTYPX) ;Get Type (Internal and External Value) by IEN
126 ; Input -- HDISYIEN HDIS System file IEN (Optional- Default current system)
127 ; Output -- 1=Successful and 0=Failure
128 ; If Successful:
129 ; HDISTYPE Type (Internal Value)
130 ; HDISTYPX Type (External Value)
131 ;Initialize output
132 S (HDISTYPE,HDISTYPX)=""
133 ;Set HDIS System file IEN to current system, if needed
134 I '$D(HDISYIEN),$$CURSYS(.HDISYIEN)
135 ;Check for missing variable, exit if not defined
136 I $G(HDISYIEN)'>0 G GETTYPEQ
137 ;Check for Domain/IP Address by IEN
138 I $D(^HDISF(7118.21,HDISYIEN,0)) S HDISTYPE=$P($G(^(0)),"^",3) D
139 . S HDISTYPX=$$GET1^DIQ(7118.21,HDISYIEN,.03)
140GETTYPEQ Q +$S($G(HDISTYPE)'=""&($G(HDISTYPX)'=""):1,1:0)
141 ;
142 ;---- End HDIS System file (#7118.21) API(s) ----
Note: See TracBrowser for help on using the repository browser.