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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1DGPFHLU2 ;ALB/RPM - PRF HL7 BUILD OBX SEGMENT ; 2/20/03
2 ;;5.3;Registration;**425**;Aug 13, 1993
3 ;
4 Q
5 ;
6OBX(DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGFLD,DGHL) ;OBX Segment API
7 ;This function wraps the data retrieval and segment creation APIs and
8 ;returns a formatted OBX segment.
9 ;
10 ; Input:
11 ; DGSET - (required) OBX segment Set ID
12 ; DGID - (required) Observation identifier code
13 ; DGSUBID - (optional) Observation Sub-ID
14 ; DGVALUE - (required) Observation value
15 ; DGPFAH - (required) Assignment history data array
16 ; DGFLD - (optional) List of comma-separated fields (sequence #'s)
17 ; to include. Defaults to all required fields (3,11).
18 ; DGHL - HL7 environment array
19 ;
20 ; Output:
21 ; Function Value - OBX segment on success, "" on failure
22 ;
23 N DGOBX
24 N DGVAL
25 ;
26 S DGOBX=""
27 I $G(DGSET)>0,$G(DGID)?1A,$G(DGVALUE)]"" D
28 . S DGFLD=$$CKSTR^DGPFHLUT("3,11",DGFLD) ;required fields
29 . S DGFLD=","_DGFLD_","
30 . I $$OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,.DGPFAH,.DGVAL) D
31 . . S DGOBX=$$BLDSEG^DGPFHLUT("OBX",.DGVAL,.DGHL)
32 Q DGOBX
33 ;
34OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGVAL) ;build OBX value array
35 ;
36 ; Input:
37 ; DGFLD - (required) Fields string
38 ; DGSET - (required) OBX segment Set ID
39 ; DGID - (required) Observation identifier code
40 ; DGSUBID - (optional) Observation Sub-ID
41 ; DGVALUE - (required) Observation value
42 ; DGPFAH - (required) Assignment history data array
43 ;
44 ; Output:
45 ; Function Value - 1 on sucess, 0 on failure
46 ; DGVAL - OBX field array [SUB1:field, SUB2:repetition,
47 ; SUB3:component, SUB4:sub-component]
48 ;
49 N DGRSLT ;function value
50 N DGTYPE ;observation value type
51 N DGIDSTR ;observation identifier string
52 N DGDAT ;observation date
53 ;
54 S DGRSLT=0
55 I $G(DGFLD)]"",+$G(DGSET)>0,$G(DGID)?1A,$G(DGVALUE)]"" D
56 . ;
57 . ; seq 1 Set ID
58 . I DGFLD[",1," D
59 . . S DGVAL(1)=DGSET
60 . ;
61 . ; seq 2 Value Type
62 . I DGFLD[",2," D
63 . . S DGTYPE=$S(DGID="S":"ST",DGID="N":"TX",DGID="C":"TX",1:"")
64 . . Q:(DGTYPE']"")
65 . . S DGVAL(2)=DGTYPE
66 . ;
67 . ; seq 3 Observation Identifier
68 . I DGFLD[",3," D Q:'$D(DGVAL(3)) ;required field
69 . . S DGIDSTR=$S(DGID="S":"Status",DGID="N":"Narrative",DGID="C":"Comment",1:"")
70 . . Q:(DGIDSTR']"")
71 . . S DGVAL(3,1,1)=DGID
72 . . S DGVAL(3,1,2)=DGIDSTR
73 . . S DGVAL(3,1,3)="L"
74 . ;
75 . ; seq 4 Observation Sub-ID (optional)
76 . I DGFLD[",4," D
77 . . S DGVAL(4)=$S(+$G(DGSUBID)>0:DGSUBID,1:"")
78 . ;
79 . ; seq 5 Observation Value
80 . I DGFLD[",5," D
81 . . S DGVAL(5)=DGVALUE
82 . ;
83 . ; seq 6 Units
84 . I DGFLD[",6," D
85 . . S DGVAL(6)=""
86 . ;
87 . ; seq 7 Reference Range
88 . I DGFLD[",7," D
89 . . S DGVAL(7)=""
90 . ;
91 . ; seq 8 Abnormal Flags
92 . I DGFLD[",8," D
93 . . S DGVAL(8)=""
94 . ;
95 . ; seq 9 Probability
96 . I DGFLD[",9," D
97 . . S DGVAL(9)=""
98 . ;
99 . ; seq 10 Nature of Abnormal Test
100 . I DGFLD[",10," D
101 . . S DGVAL(10)=""
102 . ;
103 . ; seq 11 Observ Result Status
104 . I DGFLD[",11," D
105 . . S DGVAL(11)="F"
106 . ;
107 . ; seq 12 Date last Obs Normal Values
108 . I DGFLD[",12," D
109 . . S DGVAL(12)=""
110 . ;
111 . ; seq 13 User Defined Access Checks
112 . I DGFLD[",13," D
113 . . S DGVAL(13)=""
114 . ;
115 . ; seq 14 Date/Time of the Observation
116 . I DGFLD[",14," D
117 . . S DGDAT=$$FMTHL7^XLFDT(+$G(DGPFAH("ASSIGNDT")))
118 . . S DGVAL(14)=$S(DGDAT>0:DGDAT,1:"")
119 . ;
120 . ; seq 15 Producer's ID
121 . I DGFLD[",15," D
122 . . S DGVAL(15)=""
123 . ;
124 . ; seq 16 Responsible Observer
125 . I DGFLD[",16," D
126 . . S DGVAL(16)=""
127 . ;
128 . ; seq 17 Observation Method
129 . I DGFLD[",17," D
130 . . S DGVAL(17)=""
131 . ;
132 . S DGRSLT=1
133 I 'DGRSLT K DGVAL
134 Q DGRSLT
135 ;
136BLDOBXTX(DGROOT,DGTXTA,DGID,DGPFAH,DGHL,DGSEG,DGSET) ;build OBX text segments
137 ;
138 ; Input:
139 ; DGROOT - (required) Closed root array or global name for segment
140 ; storage
141 ; DGTXTA - (required) Closed root array containing text
142 ; DGID - (required) OBX segment Observation ID
143 ; DGPFAH - (required) Assignment history data array
144 ; DGHL - (required) VistA HL7 environment array
145 ; DGSEG - (optional) Previous segment # in DGROOT
146 ; DGSET - (optional) Previous OBX Set ID
147 ;
148 ; Output:
149 ; Function Value - 1 on success, 0 on failure
150 ;
151 N DGI ;generic counter
152 N DGOBX ;formatted OBX segment
153 N DGOBXTX ;array of pre-processed text lines
154 N DGRSLT ;function value
155 N DGSTR ;list of OBX segment fields to include
156 ;
157 S DGRSLT=0
158 S DGSTR="1,2,3,5,11,14"
159 I $G(DGROOT)]"",$G(DGTXTA)]"",$G(DGID)?1A,$D(DGPFAH) D
160 . Q:'$$BLDTEXT^DGPFHLUT(DGTXTA,.DGHL,.DGOBXTX)
161 . S DGSEG=$G(DGSEG,0)
162 . S DGSET=$G(DGSET,0)
163 . S DGI=0
164 . F S DGI=$O(DGOBXTX(DGI)) Q:'DGI D Q:(DGOBX="")
165 . . S DGSET=DGSET+1
166 . . S DGOBX=$$OBX^DGPFHLU2(DGSET,DGID,"",DGOBXTX(DGI),.DGPFAH,DGSTR,.DGHL)
167 . . Q:(DGOBX="")
168 . . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGOBX
169 . Q:(DGOBX)=""
170 . ;
171 . ;success
172 . S DGRSLT=1
173 ;
174 Q DGRSLT
Note: See TracBrowser for help on using the repository browser.