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

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1DGROHLU1 ;DJH/AMA - ROM HL7 BUILD FDA SEGMENT ; 24 Jun 2003 3:53 PM
2 ;;5.3;Registration;**533,572**;Aug 13, 1993
3 ;
4 Q
5 ;
6FDA(DGROFDA,DGSEGSTR) ; FDA SEGMENT API
7 ;Called from BLDORF^DGROHLQ
8 ;
9 ; INPUT:
10 ; DGROFDA - POINTER TO THE GLOBAL DATA ARRAY, ^TMP("DGROFDA",$J)
11 ;
12 ; OUTPUT:
13 ; DGSEGSTR - ARRAY OF SEGMENTS
14 ;
15 N DGVAL
16 ;
17 Q:'$D(@DGROFDA)
18 I $$FDAVAL(.DGVAL) D
19 . D BLDFDA("FDA",.DGVAL,.DGSEGSTR,.DGHL)
20 Q
21 ;
22FDAVAL(DGVAL) ; FORMAT THE DATA ARRAY FOR THE FDA SEGMENT
23 ; Input:
24 ; DGVAL - array of data
25 ;
26 N DGRSLT,DGX,DGF,DGIEN,DGFLD,DGEI,DGCHAR
27 ;
28 S (DGRSLT,DGX)=0
29 S DGF=0 F S DGF=$O(@DGROFDA@(DGF)) Q:'DGF D
30 . S DGIEN="" F S DGIEN=$O(@DGROFDA@(DGF,DGIEN)) Q:DGIEN="" D
31 . . S DGFLD=0 F S DGFLD=$O(@DGROFDA@(DGF,DGIEN,DGFLD)) Q:'DGFLD D
32 . . . S DGX=DGX+1
33 . . . S DGVAL(DGX,1,1)=DGF
34 . . . S DGVAL(DGX,1,2)=DGIEN
35 . . . S DGVAL(DGX,1,3)=DGFLD
36 . . . ;*Get all External values (DG*5.3*572)
37 . . . S DGVAL(DGX,2,1)=$G(@DGROFDA@(DGF,DGIEN,DGFLD,"E"))
38 . S DGRSLT=1
39 ;
40 Q DGRSLT
41 ;
42BLDFDA(DGTYP,DGVAL,DGSEGSTR,DGHL) ;FDA SEGMENT BUILDER
43 ;BUILDS THE FDA SEGMENT IN THE FOLLOWING FORMAT:
44 ; FDA ^ FILE | IEN | FIELD ~ EXTERNAL VALUE
45 ; ADD ^ FILE | IEN | FIELD ~ EXTERNAL VALUE
46 ; ADD ^ FILE | IEN | FIELD ~ EXTERNAL VALUE
47 ; etc., etc.
48 ;
49 ; INPUT:
50 ; DGTYP - SEGMENT TYPE
51 ; DGVAL - FIELD DATA ARRAY [SUB1:field, SUB2:repetition
52 ; SUB3:component, SUB4:sub-component]
53 ; DGSEGSTR - ARRAY OF SEGMENTS, EACH NO GREATER THAN 245 CHARACTERS
54 ; DGHL - HL7 ENVIRONMENT ARRAY
55 ;
56 ; OUTPUT:
57 ; FUNCTION VALUE - FORMATTED ARRAY OF HL7 SEGMENTS ON SUCCESS, "" ON FAILURE
58 ;
59 N DGCNT ;array counter
60 N DGFS ;field separator
61 N DGCS ;component separator
62 N DGRS ;repetition separator
63 N DGSS ;sub-component separator
64 N DGFLD ;field subscript
65 N DGFLDVAL ;field value
66 N DGSEP ;HL7 separator
67 N DGREP ;repetition subscript
68 N DGREPVAL ;repetition value
69 N DGCMP ;component subscript
70 N DGCMPVAL ;component value
71 N DGSUB ;sub-component subscript
72 N DGSUBVAL ;sub-component value
73 ;
74 Q:($G(DGTYP)']"")
75 ;
76 S DGCNT=1
77 S DGSEGSTR(DGCNT)=DGTYP
78 S DGFS=DGHL("FS")
79 S DGCS=$E(DGHL("ECH"))
80 S DGRS=$E(DGHL("ECH"),2)
81 S DGSS=$E(DGHL("ECH"),4)
82 ;
83 F DGFLD=1:1:$O(DGVAL(""),-1) D
84 . I DGTYP="ADD" S DGCNT=DGCNT+1,DGSEGSTR(DGCNT)=DGTYP
85 . S DGFLDVAL=$G(DGVAL(DGFLD)),DGSEP=DGFS
86 . D ADD(DGFLDVAL,DGSEP,.DGSEGSTR,.DGCNT)
87 . F DGREP=1:1:$O(DGVAL(DGFLD,""),-1) D
88 . . S DGREPVAL=$G(DGVAL(DGFLD,DGREP))
89 . . S DGSEP=$S(DGREP=1:"",1:DGRS)
90 . . D ADD(DGREPVAL,DGSEP,.DGSEGSTR,.DGCNT)
91 . . F DGCMP=1:1:$O(DGVAL(DGFLD,DGREP,""),-1) D
92 . . . S DGCMPVAL=$G(DGVAL(DGFLD,DGREP,DGCMP))
93 . . . S DGSEP=$S(DGCMP=1:"",1:DGCS)
94 . . . D ADD(DGCMPVAL,DGSEP,.DGSEGSTR,.DGCNT)
95 . . . F DGSUB=1:1:$O(DGVAL(DGFLD,DGREP,DGCMP,""),-1) D
96 . . . . S DGSUBVAL=$G(DGVAL(DGFLD,DGREP,DGCMP,DGSUB))
97 . . . . S DGSEP=$S(DGSUB=1:"",1:DGSS)
98 . . . . D ADD(DGSUBVAL,DGSEP,.DGSEGSTR,.DGCNT)
99 . S DGTYP="ADD"
100 Q
101 ;
102ADD(DGVAL,DGSEP,DGSEGSTR,DGCNT) ;append a value onto segment
103 ;
104 ; Input:
105 ; DGVAL - value to append
106 ; DGSEP - HL7 separator
107 ;
108 ; Output:
109 ; DGSEGSTR(DGCNT) - segment passed by reference
110 ;
111 S DGSEP=$G(DGSEP)
112 S DGVAL=$G(DGVAL)
113 S DGSEGSTR(DGCNT)=DGSEGSTR(DGCNT)_DGSEP_DGVAL
114 Q
Note: See TracBrowser for help on using the repository browser.