source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLTF.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1HLTF ;AISC/SAW,JRP-Create/Process Message Text File Entries ;10/17/2007 09:41
2 ;;1.6;HEALTH LEVEL SEVEN;**1,19,43,55,109,120,122**;Oct 13, 1995;Build 14
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7FILE ;Create Entries in files 772 and 773 for Version 1.5 Interface Only
8 D CREATE(,.HLDA,.HLDT,.HLDT1)
9 Q
10CREATE(HLMID,MTIEN,HLDT,HLDT1) ;Create entries in Message Text (#772)
11 ;
12 ;Input : HLMID = Variable in which value of message ID will be
13 ; returned (pass by reference)
14 ; MTIEN = Variable in which IEN of Message Text file entry
15 ; will be returned (pass by reference)
16 ; HLDT = Variable in which current date/time in FM internal
17 ; format will be returned (pass by reference)
18 ; HLDT1 = Variable in which current date/time in HL7 format
19 ; will be returned (pass by reference)
20 ;
21 ;Output : See above
22 ;
23 ;Notes : If HLDT has a value [upon entry], the created entries will
24 ; be given that value for their date/time (value of .01)
25 ; : Current date/time used if HLDT is not passed or invalid
26 ;
27 ;Make entry in Message Administration file
28 N Y
29 S HLDT=$G(HLDT)
30 D MT(.HLDT)
31 S Y=$$CHNGMID(MTIEN,.HLMID),HLDT1=$$HLDATE^HLFNC(HLDT)
32 Q
33TCP(HLMID,MTIEN,HLDT) ;create new message in 772 & 773 entries
34 ;used for incoming messages and outgoing responses
35 ;Input : HLMID = Variable in which value of message ID will be
36 ; returned (pass by reference)
37 ; MTIEN = Variable in which IEN of file 773 entry
38 ; will be returned (pass by reference)
39 ; HLDT = Variable in which current date/time in FM internal
40 ; format will be returned (pass by reference)
41 ;
42 S HLDT=$G(HLDT),HLMID=$G(HLMID)
43 D MT(.HLDT)
44 S MTIEN=$$MA(MTIEN,.HLMID)
45 Q
46 ;
47MT(HLX) ;Create entry in Message Text file (#772)
48 ;
49 ;Input : HLX = Date/time entry in file should be given (value of .01)
50 ; Defaults to current date/time
51 ;
52 ;Output : HLDT = Date/time of created entry (value of .01)
53 ; : HLDT1 = HLDT in HL7 format
54 ;
55 ;Notes : HLX must be in FileMan format (default value used if not)
56 ; : HLDT will be in FileMan format
57 ; : MTIEN is ien in file 772
58 ;
59 ;Check for input
60 S HLX=$G(HLX)
61 ;Declare variables
62 N DIC,DD,DO,HLCNT,HLJ,X,Y
63 F HLCNT=0:1 D Q:Y>0 H HLCNT
64 . I (HLX'?7N.1".".6N) S HLX=$$NOW^XLFDT
65 . S DIC="^HL(772,",DIC(0)="L",(HLDT,X)=HLX
66 . S Y=$$STUB772(X) ; This call substituted for D FILE^DICN by HL*1.6*109
67 . ;Entry not created - try again
68 . I Y<0 S HLX="" Q
69 . S MTIEN=+Y
70 ;***If we didn't get a record in 772, need to do something
71 I Y<0 Q
72 S HLDT1=$$HLDATE^HLFNC(HLDT)
73 Q
74 ;add to Message Admin file #773
75MA(X,HLMID) ;X=ien in file 772, HLMID=msg. id (passed by ref.)
76 ;return ien in file 773
77 ;
78 ; patch HL*1.6*122: MPI-client/server start
79 F L +^HL(772,+$G(X)):10 Q:$T H 1
80 Q:'$G(^HL(772,X,0)) 0
81 L -^HL(772,+$G(X))
82 ; patch HL*1.6*122: MPI-client/server end
83 ;
84 N DA,DD,DO,DIC,DIE,DR,HLDA,HLCNT,HLJ,Y
85 S DIC="^HLMA(",DIC(0)="L"
86 F HLCNT=0:1 D Q:Y>0 H HLCNT
87 . S Y=$$STUB773(X) ; This call substituted for D FILE^DICN by HL*1.6*109
88 ;***If we didn't get a record in 773, need to do something
89 I Y<0 Q 0
90 S HLDA=+Y,HLMID=$$MAID(HLDA,$G(HLMID))
91 Q HLDA
92 ;
93MAID(Y,HLMID) ;Determine message ID (if needed) & store message ID
94 ;Y=ien in 773, HLMID=id, Output message id
95 N HLJ
96 ;need to have id contain institution number to make unique
97 S:$G(HLMID)="" HLMID=+$P($$PARAM^HLCS2,U,6)_Y
98 S HLJ(773,Y_",",2)=HLMID
99 D FILE^HLDIE("","HLJ","","MAID","HLTF") ;HL*1.6*109
100 Q HLMID
101 ;
102CHNGMID(PTRMT,NEWID) ;Change message ID for entry in Message Text file
103 ;Input : PTRMT - Pointer to entry in Message Text file (#772)
104 ; NEWID - New message ID
105 ;Output : 0 = Success
106 ; -1^ErrorText = Error/Bad input
107 ;
108 ;Check input
109 S PTRMT=+$G(PTRMT)
110 S NEWID=$G(NEWID)
111 Q:('$D(^HL(772,PTRMT,0))) "-1^Did not pass valid pointer to Message Text file (#772)"
112 N HLJ
113 I $G(NEWID)="" S NEWID=+$P($$PARAM^HLCS2,U,6)_PTRMT
114 S HLJ(772,PTRMT_",",6)=NEWID
115 D FILE^HLDIE("","HLJ","","CHNGMID","HLTF") ; HL*1.6*109
116 Q 0
117 ;
118OUT(HLDA,HLMID,HLMTN) ;File Data in Message Text File for Outgoing Message
119 ;Version 1.5 Interface Only
120 ;
121 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
122 ; OUT, IN, and ACK to HLTF2 routine.
123 ;
124 D OUT^HLTF2($G(HLDA),$G(HLMID),$G(HLMTN))
125 Q
126 ;
127IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
128 ;Version 1.5 Interface Only
129 ;
130 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
131 ; OUT, IN, and ACK to HLTF2 routine.
132 ;
133 D IN^HLTF2($G(HLMTN),$G(HLMID),$G(HLTIME))
134 Q
135 ;
136ACK(HLMSA,HLIO,HLDA) ;Process 'ACK' Message Type - Version 1.5 Interface Only
137 ;
138 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
139 ; OUT, IN, and ACK to HLTF2 routine.
140 ;
141 D ACK^HLTF2($G(HLMSA),$G(HLIO),$G(HLDA))
142 Q
143 ;
144STUB772(FLD01,OS) ;
145 ;This function creates a new stub record in file 772. The Stub record may consist of only the 0 node with a value of "^". If a value is passed in for the .01 field it will be included in the 0 node and its "B" x-ref set.
146 ;Inputs:
147 ; OS (optional), the value of ^%ZOSF("OS")
148 ; FLD01 (optional), the value for the .01 field
149 ;Output - the function returns the ien of the newly created record
150 ;
151 N IEN
152 I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
153 ;
154 I OS'["DSM",OS'["OpenM" D
155 .F L +^HLCS(869.3,1,772):10 S IEN=+$G(^HLCS(869.3,1,772))+1,^HLCS(869.3,1,772)=IEN S:$D(^HL(772,IEN)) IEN=0,^HLCS(869.3,1,772)=($O(^HL(772,":"),-1)\1) L -^HLCS(869.3,1,772) Q:IEN
156 E D
157 .F S IEN=$I(^HLCS(869.3,1,772),1) S:$D(^HL(772,IEN)) IEN=0,^HLCS(869.3,1,772)=($O(^HL(772,":"),-1)\1) Q:IEN
158 ;
159 ; patch HL*1.6*122: MPI-client/server start
160 F L +^HL(772,IEN):10 Q:$T H 1
161 S ^HL(772,IEN,0)=$G(FLD01)_"^"
162 I $L($G(FLD01)) S ^HL(772,"B",FLD01,IEN)=""
163 L -^HL(772,IEN)
164 ; patch HL*1.6*122: MPI-client/server end
165 ;
166 Q IEN
167 ;
168STUB773(FLD01,OS) ;
169 ;This function creates a new stub record in file 772. The Stub record may consist of only the 0 node with a value of "^". If a value is passed in for the .01 field it will be included in the 0 node and its "B" x-ref set.
170 ;Inputs:
171 ; OS (optional), the value of ^%ZOSF("OS")
172 ; FLD01 (optional), the value for the .01 field
173 ;Output - the function returns the ien of the newly created record
174 ;
175 N IEN
176 I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
177 ;
178 I OS'["DSM",OS'["OpenM" D
179 .F L +^HLCS(869.3,1,773):10 S IEN=+$G(^HLCS(869.3,1,773))+1,^HLCS(869.3,1,773)=IEN S:$D(^HLMA(IEN)) IEN=0,^HLCS(869.3,1,773)=($O(^HLMA(":"),-1)\1) L -^HLCS(869.3,1,773) Q:IEN
180 E D
181 .F S IEN=$I(^HLCS(869.3,1,773),1) S:$D(^HLMA(IEN)) IEN=0,^HLCS(869.3,1,773)=($O(^HLMA(":"),-1)\1) Q:IEN
182 ;
183 ; patch HL*1.6*122: MPI-client/server
184 F L +^HLMA(IEN):10 Q:$T H 1
185 S ^HLMA(IEN,0)=$G(FLD01)_"^"
186 I $L($G(FLD01)) S ^HLMA("B",FLD01,IEN)=""
187 L -^HLMA(IEN)
188 ;
189 Q IEN
Note: See TracBrowser for help on using the repository browser.