source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLTF1.m@ 952

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

initial load of FOIAVistA 6/30/08 version

File size: 6.3 KB
Line 
1HLTF1 ;AISC/SAW/MTC-Process Message Text File Entries (Cont'd) ;10/17/2007 09:43
2 ;;1.6;HEALTH LEVEL SEVEN;**5,8,22,25,19,78,122**;Oct 13, 1995;Build 14
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5MERGE15(ARAYTYPE,MTIEN,SUB1,SUB2) ;Merge Local/Global Array From Application into
6 ;Message Text File
7 ;
8 ;This is a routine call with parameter passing. There are no output
9 ;parameters returned by this call.
10 ;
11 ;** Merges incoming data for v1.5 applications only **
12 ;
13 ;Required input parameters
14 ; MTIEN = The IEN from the Message Text file of the entry to be
15 ; updated
16 ; ARAYTYPE = Array type, G for global or L for local
17 ; SUB1 = The first level subscript of the array. Must be
18 ; either HLS or HLA
19 ;Optional input parameter
20 ; SUB2 = A second subscript associated with the array
21 ;
22 ;Check for required parameters
23 I "GL"'[$G(ARAYTYPE)!($G(SUB1)']"")!('$G(MTIEN)) G MRGE15X
24 ;
25 N HLCHAR,HLEVN,HLFS,I,X,X1,X2,X3 S (HLCHAR,HLEVN,X)=0
26 ;
27 ;Merge data from a global array with two subscript
28 I ARAYTYPE="G",$G(SUB2)'="" D
29 . S X="",I=0
30 . F S X=$O(^TMP(SUB1,$J,SUB2,X)) Q:'X S I=I+1,X1=^TMP(SUB1,$J,SUB2,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1
31 ;
32 ;Merge data from a global array with one subscripts
33 I ARAYTYPE="G",$G(SUB2)="" D
34 . S X="",I=0
35 . F S X=$O(^TMP(SUB1,$J,X)) Q:'X S I=I+1,X1=^TMP(SUB1,$J,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1
36 ;
37 ;Merge data from a local array with one subscript
38 I ARAYTYPE="L" D
39 . S X="",I=0
40 . F S X=$O(HLA(SUB1,X)) Q:'X S I=I+1,X1=HLA(SUB1,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1
41 ;
42 ;-- update 0 node for message text
43 S ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
44 ;
45 ;File message statistics
46 D STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
47 ;
48MRGE15X ;-- exit merge
49 Q
50 ;
51MERGE(ARAYTYPE,MTIEN,SUB1,SUB2) ;Merge Local/Global Array From Application into
52 ;Message Text File
53 ;
54 ;This is a routine call with parameter passing. There are no output
55 ;parameters returned by this call.
56 ;
57 ;Required input parameters
58 ; MTIEN = The IEN from the Message Text file of the entry to be
59 ; updated
60 ; ARAYTYPE = Array type, G for global or L for local
61 ; SUB1 = The first level subscript of the array. Must be
62 ; either HLS or HLA
63 ;Optional input parameter
64 ; SUB2 = A second subscript associated with the array
65 ;
66 ;Check for required parameters
67 I "GL"'[$G(ARAYTYPE)!($G(SUB1)']"")!('$G(MTIEN)) G MERGEX
68 ;
69 N HLCHAR,HLEVN,HLFS,I,X,X1,X2,X3 S (HLCHAR,HLEVN,X)=0
70 ;
71 ; patch HL*1.6*122: MPI-client/server
72 F L +^HL(772,+$G(MTIEN)):10 Q:$T H 1
73 ;
74 ;Merge data from a global array with two subscript
75 I ARAYTYPE="G",$G(SUB2)'="" D
76 . S X="",I=0
77 . F S X=$O(^TMP(SUB1,$J,SUB2,X)) Q:'X S I=I+1,X1=^TMP(SUB1,$J,SUB2,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1,X2=$D(^TMP(SUB1,$J,SUB2,X)) D
78 .. I X2=11 S X3="" F S X3=$O(^TMP(SUB1,$J,SUB2,X,X3)) Q:'X3 D
79 ... S I=I+1,X1=$G(^TMP(SUB1,$J,SUB2,X,X3)),HLCHAR=HLCHAR+$L(X1),^HL(772,MTIEN,"IN",I,0)=X1
80 .. S I=I+1,^HL(772,MTIEN,"IN",I,0)="" Q
81 ;
82 ;Merge data from a global array with one subscripts
83 I ARAYTYPE="G",$G(SUB2)="" D
84 . S X="",I=0
85 . F S X=$O(^TMP(SUB1,$J,X)) Q:'X S I=I+1,X1=^TMP(SUB1,$J,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1,X2=$D(^TMP(SUB1,$J,X)) D
86 .. I X2=11 S X3="" F S X3=$O(^TMP(SUB1,$J,X,X3)) Q:'X3 D
87 ... S I=I+1,X1=$G(^TMP(SUB1,$J,X,X3)),HLCHAR=HLCHAR+$L(X1),^HL(772,MTIEN,"IN",I,0)=X1
88 .. S I=I+1,^HL(772,MTIEN,"IN",I,0)="" Q
89 ;
90 ;Merge data from a local array with one subscript
91 I ARAYTYPE="L" D
92 . S X="",I=0
93 . F S X=$O(HLA(SUB1,X)) Q:'X S I=I+1,X1=HLA(SUB1,X),HLCHAR=HLCHAR+$L(X1) S:$E(X1,1,3)="MSH" HLFS=$E(X1,4),$P(X1,HLFS,8)="",HLEVN=HLEVN+1 S ^HL(772,MTIEN,"IN",I,0)=X1,X2=$D(HLA(SUB1,X)) D
94 .. I X2=11 S X3="" F S X3=$O(HLA(SUB1,X,X3)) Q:'X3 D
95 ... S I=I+1,X1=$G(HLA(SUB1,X,X3)),HLCHAR=HLCHAR+$L(X1),^HL(772,MTIEN,"IN",I,0)=X1
96 .. S I=I+1,^HL(772,MTIEN,"IN",I,0)="" Q
97 ;
98 S:HLEVN=0 HLEVN=1
99 ;X=ien in file 773 for TCP messages
100 S X=+$O(^HLMA("B",MTIEN,0))
101 ;batch message type
102 I X,$P($G(^HLMA(X,0)),U,5)="B" D BTS
103 I 'X,$P(^HL(772,MTIEN,0),U,8),$P(^HL(772,$P(^(0),U,8),0),U,14)="B" D BTS
104 ;
105 ;-- update 0 node for message text
106 S ^HL(772,MTIEN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
107 ;
108 ; patch HL*1.6*122: MPI-client/server
109 L -^HL(772,+$G(MTIEN))
110 ;
111 ;File message statistics
112 D STATS^HLTF0(MTIEN,HLCHAR,HLEVN)
113 ;
114MERGEX ;-- exit merge
115 Q
116 ;
117BTS ; create batch trailer seg (BTS)
118 ;HL*1.6*78 to obtain and insert FIELD SEPARATOR, HLFS
119 N HLFS,HLSAN
120 S HLFS=$G(HL("FS")) ; obtain from HL array
121 ; or obtain from sending application; default to "^"
122 I HLFS="" D S:HLFS="" HLFS="^"
123 . S HLSAN=$P($G(^HL(772,MTIEN,0)),U,2)
124 . S:HLSAN HLFS=$G(^HL(771,HLSAN,"FS"))
125 S I=I+1,^HL(772,MTIEN,"IN",I,0)="BTS"_HLFS_HLEVN,I=I+1,^HL(772,MTIEN,"IN",I,0)=""
126 Q
127 ;
128MRGINT(MTOUT,MTIN,HDR) ;Merge Internal to Internal Message from the
129 ; Outbound message in 772 (MTOUT) to an Inbound entry (MTIN). The process
130 ; will involve Moving the Header and Text into 772.
131 ;
132 ;Required input parameters
133 ; MTOUT= Internal entry number of the Outbound message
134 ; MTIN = Internal entry number of the Inbound message
135 ; HDR = Name of the array that contains HL7 Header segment
136 ; format: HLHDR - Used with indirection to build message in out
137 ; queue
138 ; This routine will first take the header information in the array
139 ; specified by HDR and merge into the Message Text field of file 870.
140 ; Then it will move the message contained in 772 (MTIEN) into 870.
141 ;
142 ;Check for required parameters
143 I '$G(MTOUT)!('$G(MTIN))!(HDR="") Q
144 ;
145 ;-- initilize
146 N I,X
147 S I=0
148 ;
149 ;-- move header into 772 from HDR array
150 S X="" F S X=$O(@HDR@(X)) Q:'X D
151 . S I=I+1,^HL(772,MTIN,"IN",I,0)=@HDR@(X)
152 S I=I+1,^HL(772,MTIN,"IN",I,0)=""
153 ;
154 ;Move data from Message Text (MTOUT) file TO Message Text 772 (MTIN)
155 S X=0 F S X=$O(^HL(772,MTOUT,"IN",X)) Q:X="" S I=I+1 D
156 . S ^HL(772,MTIN,"IN",I,0)=$G(^HL(772,MTOUT,"IN",X,0))
157 ;
158 ;-- update 0 node of message and format arrays
159 S ^HL(772,MTIN,"IN",0)="^^"_I_"^"_I_"^"_$$DT^XLFDT_"^"
160 ;
161 Q
Note: See TracBrowser for help on using the repository browser.