source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VLL.m@ 649

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1LA7VLL ;DALOI\JMC - Setup HL7 v1.6 Logical Link for Consolidation ; 12/3/1997
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,55,64**;Sep 27, 1994
3 ;
4 ; Reference to HL LOGICAL LINK file (#870) supported by DBIA #1495, 1496, 2063
5 ; Reference to PROTOCOL file (#101) supported by DBIA #872
6 ; Reference to MAIL GROUP file (#3.8) supported by DBIA #2061
7 ;
8MAIL(LRI) ;
9 ;
10 Q:LRI=""
11 ;
12 N DA,DIC,DIE,DLAYGO,DR,FDA,LA7DIE,LA7IENS,LA7LINK,LA7VMGP,LA7VX,LA7X,LA7Y,X
13 ;
14 S LA7VMGP="LA7V "_$P(LRI,"^") D MAILGRP
15 ;
16 W !!,"Updating HL LOGICAL LINK file (#870)."
17 S LA7X="LA7V"_$P(LRI,"^"),LA7Y=+$$FIND1^DIC(870,"","OX",LA7X)
18 I LA7Y S LA7LINK(LA7Y)=LA7X
19 ; Check for old spelling using 'space' in name
20 I LA7Y<1 D
21 . S LA7Y=+$$FIND1^DIC(870,"","OX","LA7V "_$P(LRI,U))
22 . I LA7Y>0 S LA7LINK(LA7Y)=LA7X,FDA(1,870,LA7Y_",",.01)=LA7X
23 I LA7Y<1 D
24 . W !,?5,"Adding LA7V"_$P(LRI,"^")
25 . S X="LA7V"_$P(LRI,"^"),DIC="^HLCS(870,",DIC(0)="L",DLAYGO=870
26 . D ^DIC
27 . I Y>0 S LA7Y=+Y,LA7LINK(LA7Y)=$P(Y,U,2)
28 I LA7Y<1 D Q
29 . W !!,"Failure LA7V"_$P(LRI,"^")_" was not created in file #870."
30 S LA7IENS=LA7Y_","
31 S FDA(1,870,LA7IENS,2)="MAILMAN"
32 S FDA(1,870,LA7IENS,100.01)=LA7VMGP
33 D FILE^DIE("E","FDA(1)","LA7DIE(1)")
34 D CLEAN^DILF
35 D LL
36 ;
37 Q
38 ;
39MAILGRP ; Create mail group for HL7 protocol logical link
40 ;
41 N DA,DIC,DLAYGO,DOMAIN,LA738,LA7VDESC,LA7VXMY
42 ;
43 W !!,"Creating mail group "_LA7VMGP_" for use by the"
44 W !,"HL7 v1.6 Logical Link "_LA7VMGP_"."
45 ;
46 S LA7VXMY=""
47 S LA7VDESC(1)="This mail group is used by the HL7 Logical Link file for "
48 S LA7VDESC(2)="transmitting Lab data to site "_$P(LRI,"^",2)_"."
49 S LA738=$$MG^XMBGRP(LA7VMGP,0,DUZ,1,.LA7VXMY,.LA7VDESC,1)
50 I LA738<0 D Q
51 . W !!,"Failure: mail group ",LA7VMGP," was not created in file #3.8."
52 ;
53 S DOMAIN=$$GET1^DIQ(4,+$P(LRI,"^",4)_",",60)
54 I $G(DOMAIN)="" D ERROR Q
55 ;
56 ; Add remote member to mail group
57 S DA(1)=LA738,DIC("P")=$P(^DD(3.8,12,0),U,2),DIC="^XMB(3.8,"_DA(1)_",6,",DIC(0)="L",DLAYGO=3.812
58 S X="S.HL V16 SERVER@"_DOMAIN
59 D ^DIC
60 Q
61 ;
62ERROR ; Error creating domain
63 ;
64 W !!,"The INSTITUTION file (#4) entry for "_$P(LRI,"^",2)_" does not contain a domain."
65 W !,"Unable to create the COLLECTION system link for mail group ",$G(LA7VMGP),"."
66 W !,"The REMOTE MEMBER, S.HL V16 SERVER@domain name will need to be manually"
67 W !,"added to the mail group "_$G(LA7VMGP),"."
68 Q
69 ;
70 ;
71TCP(LRI,PRIMARY) ;
72 ;
73 N DIC,DA,DIE,DR,DLAYGO,FDA,LA7DIE,LA7IENS,LA7LINK,LA7P,LA7VX,LA7X,LA7Y,X
74 ;
75 Q:LRI=""!PRIMARY=""
76 ;
77 ; Setup client logical link if one not associated with this institution
78 D LINK^HLUTIL3($P(LRI,"^",4),.LA7LINK,"")
79 I '$O(LA7LINK(0)) D
80 . W !!,"Updating HL LOGICAL LINK file (#870)."
81 . S LA7X="LA7V"_$P(LRI,U),LA7Y=+$$FIND1^DIC(870,"","OX",LA7X)
82 . I LA7Y>0 S LA7LINK(LA7Y)=LA7X
83 . ; Check for old spelling using 'space' in name
84 . I LA7Y<1 D
85 . . S LA7Y=+$$FIND1^DIC(870,"","OX","LA7V "_$P(LRI,U))
86 . . I LA7Y>0 S LA7LINK(LA7Y)=LA7X,FDA(1,870,LA7Y_",",.01)=LA7X
87 . I LA7Y<1 D
88 . . W !,?5,"Adding "_LA7X
89 . . S X=LA7X,DIC="^HLCS(870,",DIC(0)="L",DLAYGO=870
90 . . D ^DIC
91 . . I Y>0 S LA7Y=+Y,LA7LINK(LA7Y)=$P(Y,U,2)
92 . I LA7Y<1 D Q
93 . . W !!,"Failure "_LA7X_" was not created in file #870."
94 . S LA7IENS=LA7Y_","
95 . S FDA(1,870,LA7IENS,2)="TCP"
96 . S FDA(1,870,LA7IENS,100.01)="@"
97 . D FILE^DIE("E","FDA(1)","LA7DIE(1)")
98 . D CLEAN^DILF
99 ;
100 ; Setup server logical link if one not associated with this institution
101 D LINK^HLUTIL3($P(PRIMARY,"^"),.LA7P,"")
102 I '$O(LA7P(0)) D
103 . S LA7X="LA7V"_$P(PRIMARY,U,3),LA7Y=+$$FIND1^DIC(870,"","OX",LA7X)
104 . ; Check for old spelling using 'space' in name
105 . I LA7Y<1 D
106 . . S LA7Y=+$$FIND1^DIC(870,"","OX","LA7V "_$P(PRIMARY,U,3))
107 . . I LA7Y>0 S FDA(2,870,LA7Y_",",.01)=LA7X
108 . I LA7Y<1 D
109 . . W !,?5,"Adding "_LA7X
110 . . S X=LA7X,DIC="^HLCS(870,",DIC(0)="L",DLAYGO=870
111 . . D ^DIC
112 . . I Y>0 S LA7Y=+Y
113 . I LA7Y<1 D Q
114 . . W !!,"Failure "_LA7X_" was not created in file #870."
115 . K LA7IENS
116 . S LA7IENS=LA7Y_","
117 . S FDA(2,870,LA7IENS,2)="TCP"
118 . S FDA(2,870,LA7IENS,100.01)="@"
119 . D FILE^DIE("E","FDA(2)","LA7DIE(2)")
120 . D CLEAN^DILF
121 ;
122 D LL
123 Q
124 ;
125 ;
126LL ;
127 N DIR,DIRUT,DIROUT,DUOUT,DTOUT,LA7X,LINK,X
128 W !,"Updating the PROTOCOL file (#101)."
129 ;
130 S X=$O(LA7LINK(0)),LINK=LA7LINK(X)
131 I $O(HOST(0)) D
132 . S LA7X="LA7V Process Results from "_$P(LRI,"^")
133 . D SETPRO(LA7X,"770.7///"_LINK)
134 . S LA7X="LA7V Send Order to "_$P(LRI,"^")
135 . D SETPRO(LA7X,"770.7///"_LINK)
136 ;
137 I $O(REMOTE(0)) D
138 . S LA7X="LA7V Send Results to "_$P(LRI,"^")
139 . D SETPRO(LA7X,"770.7///"_LINK)
140 . S LA7X="LA7V Process Order from "_$P(LRI,"^")
141 . D SETPRO(LA7X,"770.7///"_LINK)
142 ;
143 S DIR(0)="E" D ^DIR
144 Q
145 ;
146 ;
147SETPRO(LA7X,LA7FLDS) ;
148 ;
149 N DA,DIC,DIE,DLAYGO,DR,D0,X,Y
150 ;
151 S X=$G(LA7X),DIC="^ORD(101,",DLAYGO=101,DIC(0)="LM"
152 D ^DIC
153 I +Y<1 Q
154 ;
155 S DA=+Y,DR=LA7FLDS,DIE=DIC
156 D ^DIE
157 ;
158 Q
Note: See TracBrowser for help on using the repository browser.