source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLTF1.m@ 1766

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

revised back to 6/30/08 version

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