1 | MHVU2 ;WAS/GPM - UTILITIES ; 7/25/05 3:48pm [1/7/08 10:58pm]
|
---|
2 | ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22
|
---|
3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | Q
|
---|
6 | ;
|
---|
7 | TOGGLE(EXTRACT,VAL,ERR) ; Enable or disable the EXTRACT passed by setting the
|
---|
8 | ; value of the BLOCKED field (.03) in MHV REQUEST TYPE file (2275.3)
|
---|
9 | ; to NO or YES respectively.
|
---|
10 | ;
|
---|
11 | ; Input: EXTRACT - String name of the extract
|
---|
12 | ; Example: "CHEMISTRY"
|
---|
13 | ; VAL - "ENABLE" or "DISABLE"
|
---|
14 | ;
|
---|
15 | ; Output: ERR - Error Text
|
---|
16 | ;
|
---|
17 | N IEN,IENS,FDA
|
---|
18 | K ERR
|
---|
19 | S ERR=""
|
---|
20 | I EXTRACT="" S ERR="EXTRACT PARAMETER NULL" Q 0
|
---|
21 | S VAL=$S(VAL="ENABLE":0,VAL="DISABLE":1,1:"")
|
---|
22 | I VAL="" S ERR="VALUE PARAMETER INVALID"_VAL Q 0
|
---|
23 | ;
|
---|
24 | S IEN=$$FIND1^DIC(2275.3,"","KX",EXTRACT,"B","","ERR")
|
---|
25 | I 'IEN D Q 0
|
---|
26 | . I '$G(ERR("DIERR")) S ERR("DIERR",1,"TEXT",1)="NOT FOUND"
|
---|
27 | . S ERR=$G(ERR("DIERR",1))_"^"_$G(ERR("DIERR",1,"TEXT",1))
|
---|
28 | . Q
|
---|
29 | ;
|
---|
30 | K ERR
|
---|
31 | S ERR=""
|
---|
32 | S IENS=IEN_","
|
---|
33 | S FDA(2275.3,IENS,.03)=VAL
|
---|
34 | D UPDATE^DIE("","FDA","","ERR")
|
---|
35 | I $G(ERR("DIERR")) S ERR=$G(ERR("DIERR",1))_"^"_$G(ERR("DIERR",1,"TEXT",1)) Q 0
|
---|
36 | ;
|
---|
37 | Q 1
|
---|
38 | ;
|
---|
39 | UPDMAP(FIELDS,NEW,ERR) ; Update entries in the MHV RESPONSE MAP file (2275.4)
|
---|
40 | ;
|
---|
41 | ; Input: FIELDS - Array of Field Values
|
---|
42 | ; FIELDS("SUBSCRIBER") - Name of subscriber protocol
|
---|
43 | ; FIELDS("PROTOCOL") - Name of event driver protocol
|
---|
44 | ; FIELDS("BUILDER") - Name of response builder routine
|
---|
45 | ; FIELDS("SEGMENT") - Name of boundary segment
|
---|
46 | ; NEW - 0 to edit, 1 to create new entry
|
---|
47 | ;
|
---|
48 | ; Output: ERR - Error Text
|
---|
49 | ;
|
---|
50 | N IEN,NAME,PROTOCOL,BUILDER,SEGMENT,FDA
|
---|
51 | K ERR
|
---|
52 | S ERR=""
|
---|
53 | S NAME=$G(FIELDS("SUBSCRIBER"))
|
---|
54 | S PROTOCOL=$G(FIELDS("PROTOCOL"))
|
---|
55 | S BUILDER=$G(FIELDS("BUILDER"))
|
---|
56 | S SEGMENT=$G(FIELDS("SEGMENT"))
|
---|
57 | I NAME="" S ERR="Missing Subscriber Protocol" Q 0
|
---|
58 | I PROTOCOL="" S ERR="Missing Response Protocol" Q 0
|
---|
59 | I BUILDER="" S ERR="Missing Builder Routine" Q 0
|
---|
60 | I SEGMENT="" S ERR="Missing Boundary Segment" Q 0
|
---|
61 | ;
|
---|
62 | ; Check if entry exists, use it if it does
|
---|
63 | S IEN=$O(^MHV(2275.4,"B",NAME,0))
|
---|
64 | I NEW,'IEN S IEN="+1"
|
---|
65 | I 'NEW,'IEN S ERR="Subscriber Not Defined" Q 0
|
---|
66 | S IEN=IEN_","
|
---|
67 | ;
|
---|
68 | S FDA(2275.4,IEN,.01)=NAME
|
---|
69 | S FDA(2275.4,IEN,.02)=PROTOCOL
|
---|
70 | S FDA(2275.4,IEN,.03)=BUILDER
|
---|
71 | S FDA(2275.4,IEN,.04)=SEGMENT
|
---|
72 | D UPDATE^DIE("E","FDA","","ERR")
|
---|
73 | I $D(ERR("DIERR")) S ERR=$G(ERR("DIERR",1,"TEXT",1)) Q 0
|
---|
74 | Q 1
|
---|
75 | ;
|
---|
76 | UPDREQ(FIELDS,NEW,ERR) ; Update entries in the MHV REQUEST TYPE file (2275.3)
|
---|
77 | ;
|
---|
78 | ; Input: FIELDS - Array of Field Values
|
---|
79 | ; FIELDS("REQUEST TYPE") - Request Type
|
---|
80 | ; FIELDS("NUMBER") - Internal Request Number
|
---|
81 | ; FIELDS("BLOCK") - 0,1 Disable Request
|
---|
82 | ; FIELDS("REALTIME") - Enable Synchronous Response
|
---|
83 | ; FIELDS("EXECUTE") - Name of execute\extract routine
|
---|
84 | ; FIELDS("BUILDER") - Name of response builder routine
|
---|
85 | ; FIELDS("DATATYPE") - External Name for Request Type
|
---|
86 | ; FIELDS("DESCRIPTION") - WP formatted array
|
---|
87 | ; NEW - 0 to edit, 1 to create new entry
|
---|
88 | ;
|
---|
89 | ; Output: ERR - Error Text
|
---|
90 | ;
|
---|
91 | N IEN,NAME,NUMBER,BLOCK,REALTIME,EXECUTE,BUILDER,DATATYPE,DESC,FDA
|
---|
92 | K ERR
|
---|
93 | S ERR=""
|
---|
94 | S NAME=$G(FIELDS("REQUEST TYPE"))
|
---|
95 | S NUMBER=$G(FIELDS("NUMBER"))
|
---|
96 | S BLOCK=$G(FIELDS("BLOCK"))
|
---|
97 | S REALTIME=$G(FIELDS("REALTIME"))
|
---|
98 | S EXECUTE=$G(FIELDS("EXECUTE"))
|
---|
99 | S BUILDER=$G(FIELDS("BUILDER"))
|
---|
100 | S DATATYPE=$G(FIELDS("DATATYPE"))
|
---|
101 | M DESC=FIELDS("DESCRIPTION")
|
---|
102 | I NAME="" S ERR="Missing Request Type" Q 0
|
---|
103 | I NEW D Q:ERR'="" 0
|
---|
104 | . S IEN="+1"
|
---|
105 | . I NUMBER="" S ERR="Missing Type Number" Q
|
---|
106 | . I BLOCK="" S ERR="Missing Blocked Setting" Q
|
---|
107 | . I REALTIME="" S ERR="Missing RealTime Setting" Q
|
---|
108 | . I EXECUTE="" S ERR="Missing Execute Routine" Q
|
---|
109 | . I BUILDER="" S ERR="Missing Builder Routine" Q
|
---|
110 | . I DATATYPE="" S ERR="Missing Data Type" Q
|
---|
111 | . I '$D(DESC) S ERR="Missing Description" Q
|
---|
112 | . Q
|
---|
113 | ;
|
---|
114 | I 'NEW D Q:ERR'="" 0
|
---|
115 | . S IEN=$O(^MHV(2275.3,"B",NAME,0))
|
---|
116 | . I 'IEN S ERR="Message Type Not Defined" Q
|
---|
117 | . I DATATYPE'="",$D(^MHV(2275.3,IEN,1,"B",DATATYPE)) S DATATYPE=""
|
---|
118 | . Q
|
---|
119 | S IEN=IEN_","
|
---|
120 | ;
|
---|
121 | S FDA(2275.3,IEN,.01)=NAME
|
---|
122 | S:NUMBER'="" FDA(2275.3,IEN,.02)=NUMBER
|
---|
123 | S:BLOCK'="" FDA(2275.3,IEN,.03)=BLOCK
|
---|
124 | S:REALTIME'="" FDA(2275.3,IEN,.04)=REALTIME
|
---|
125 | S:EXECUTE'="" FDA(2275.3,IEN,.05)=EXECUTE
|
---|
126 | S:BUILDER'="" FDA(2275.3,IEN,.06)=BUILDER
|
---|
127 | S:DATATYPE'="" FDA(2275.31,"+2,"_IEN,.01)=DATATYPE
|
---|
128 | S:$D(DESC) FDA(2275.3,IEN,2)="DESC"
|
---|
129 | D UPDATE^DIE("E","FDA","","ERR")
|
---|
130 | I $D(ERR("DIERR")) S ERR=$G(ERR("DIERR",1,"TEXT",1)) Q 0
|
---|
131 | Q 1
|
---|
132 | ;
|
---|