source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VSET1.m@ 1458

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1LA7VSET1 ;DALOI/JMC - MENU TO SETUP VISN LABS ; 12/3/1997
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,55,46,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 ;
8COLLECT ; Collection Lab Setup Menu
9 ;
10 N LA7CNT,LA7,LA7P,LA7A,REMOTE
11 ;
12 ;
13 F D Q:'LA7A
14 . S REMOTE="COLLECTION Lab(s)"
15 . D RMTBLD,RMTHDR,RMTLST,KDIR
16 . W !! S DIR(0)="NO^1:"_LA7CNT
17 . D R1HLP
18 . D ^DIR
19 . I $D(DIRUT) S LA7A=0 Q
20 . S LA7A=Y D AEREMT
21 Q
22 ;
23 ;
24RMTBLD ; Identify all COLLECTION labs using LA7 MESSAGE PARAMETER file (#62.48)
25 ;
26 N LA7,LA74,SNAME,SNUM
27 S LA7CNT=1,(LA7,LA7P)="LA7V COLLECTION "
28 F S LA7=$O(^LAHM(62.48,"B",LA7)) Q:LA7=""!(LA7'[LA7P) D
29 . S SNUM=$P(LA7,"COLLECTION ",2)
30 . S LA74=$$FINDSITE^LA7VHLU2(SNUM,2,1) Q:LA74'>0
31 . S SNAME=$P($$NS^XUAF4(LA74),"^")
32 . S REMOTE(LA7CNT)=SNUM_U_SNAME_U_LA7_U_LA74,LA7CNT=LA7CNT+1
33 S REMOTE(LA7CNT)=""
34 Q
35 ;
36 ;
37RMTHDR ; Collection setup header
38 ;
39 W @IOF,! F X=1:1:79 W "-"
40 W !,?((80-$L(REMOTE))/2),REMOTE
41 W ! F X=1:1:79 W "-"
42 W !!
43 ;
44 Q
45 ;
46 ;
47RMTLST ;
48 S LA7CNT=1,LA7=0
49 F S LA7=$O(REMOTE(LA7)) Q:'LA7 D
50 . I REMOTE(LA7)="" Q
51 . W !,LA7,".",?5,$P(REMOTE(LA7),U,2)_" ("_$P(REMOTE(LA7),U,3)_")"
52 . S LA7CNT=LA7CNT+1
53 ;
54 W !,LA7CNT,".",?5,"Add COLLECTION Lab"
55 ;
56 Q
57 ;
58 ;
59RMTHDR2 ;
60 N LA7624,LA76248,LA7870,LA7X
61 ;
62 S LA7CNT=1
63 W !!,"1. COLLECTION Lab: ",?15,$P(REMOTE(LA7A),U,2)
64 W:$P(REMOTE(LA7A),U,2)'="" " (Uneditable)"
65 ;
66 I $P(REMOTE(LA7A),U,2)="" Q
67 ;
68 D LINK^HLUTIL3($P(REMOTE(LA7A),"^",4),.LA7X,"")
69 S LA7870=+$O(LA7X(0))
70 I 'LA7870 D
71 . S LA7870=+$$FIND1^DIC(870,"","OX","LA7V"_$P(REMOTE(LA7A),U))
72 . I 'LA7870 S LA7870=+$$FIND1^DIC(870,"","OX","LA7V "_$P(REMOTE(LA7A),U))
73 . I LA7870 S LA7X(LA7870)=$$GET1^DIQ(870,LA7870_",",.01)
74 S LA7CNT=2
75 W !,"2. Logical Link (TCP/IP): ",$G(LA7X(LA7870))
76 ;
77 S LA76248=$$FIND1^DIC(62.48,"","OX","LA7V COLLECTION "_$P(REMOTE(LA7A),U)),LA7CNT=3
78 W !,"3. Message Configuration: ",$$GET1^DIQ(62.48,LA76248_",",.01)
79 Q
80 ;
81 ;
82AEREMT ;
83 ;
84 N CHA
85 ;
86 F S REMOTE="COLLECTION Lab Setup" D RMTHDR,RMTHDR2,KDIR W !! S DIR(0)="NO^1:"_LA7CNT D R2HLP D ^DIR S CHA=Y D:CHA>0 Q:+CHA'>0
87 . I CHA=1 D RLAB($P(REMOTE(LA7A),U))
88 . I CHA=2 D RLL
89 . I CHA=3 D LMC
90 Q
91 ;
92 ;
93LMC ; Edit Lab message configuration file
94 ;
95 N DIC,DA,DR,DIE,LA76248
96 ;
97 S LA76248=$$FIND1^DIC(62.48,"","OX","LA7V COLLECTION "_$P(REMOTE(LA7A),U))
98 I LA76248<0 W !,"You have not entered a "_LAB_" lab." Q
99 S DA=LA76248,DIE="^LAHM(62.48,",DR="3;4;10;@20;20;I X'="""" S Y=""@20"""
100 D ^DIE
101 Q
102 ;
103 ;
104RLAB(LRI) ;Add REMOTE LAB
105 ;
106 N INST,LA7VER
107 ;
108 I $P(REMOTE(LA7A),U)'="" D KDIR S DIR("A")="Are you sure you want to update the "_$P(REMOTE(LA7A),U,2)_" interface",DIR(0)="Y0" D ^DIR Q:+Y'>0
109 ;
110 I $P(REMOTE(LA7A),U)="" D
111 . N DIC,DA,DO
112 . S DIC="^DIC(4,",DIC(0)="AEMQZ"
113 . S DIC("S")="N LA7X S LA7X=$G(^(99)) I ($L($P(LA7X,U))&$P(LA7X,U,5)=""VA"")!($P(LA7X,U)=""""&$P(LA7X,U,5)'=""VA"")"
114 . D ^DIC Q:Y<1
115 . S INST=+Y
116 . I PRIMARY=INST!(INST=DUZ(2)) D Q
117 . . W !,"To add your Hospital as a COLLECTION site just add HOST sites."
118 . S REMOTE(LA7A+1)=REMOTE(LA7A)
119 . S REMOTE(LA7A)=$$RETFACID^LA7VHLU2(INST,2,1)_U_$P($$NS^XUAF4(INST),"^")_"^^"_INST
120 ;
121 I $P(REMOTE(LA7A),U)="" S $P(REMOTE(LA7A),U,2)="" Q
122 ;
123 I PRIMARY'=$P(REMOTE(LA7A),U) D
124 . S LA7VER=2.3
125 . I $$NVAF^LA7VHLU2($P(REMOTE(LA7A),"^",4))=1 S LA7VER=2.2
126 . D REMOTE^LA7VSTP(PRIMARY,PRSITE,$P(REMOTE(LA7A),U),$P(REMOTE(LA7A),U,2),LA7VER)
127 ;
128 Q
129 ;
130 ;
131 ;
132RLL ; add/edit logical link
133 ;
134 N HDR,PR,LA7LL
135 ;
136 S HDR="Logical Link for transmissions to/from "_$P(REMOTE(LA7A),U,2)
137 W @IOF,! F X=1:1:79 W "-"
138 W !,?((80-$L(HDR))/2),HDR
139 W ! F X=1:1:79 W "-"
140 W !,?3,"Protocol",?40,"Logical Link",!,?3,"----------",?40,"---------------",!!
141 ;
142 S PR=$O(^ORD(101,"B","LA7V Process Order from "_$P(REMOTE(LA7A),U),0))
143 I PR D GETLL^LA7VSET(PR)
144 ;
145 S PR=$O(^ORD(101,"B","LA7V Send Results to "_$P(REMOTE(LA7A),U),0))
146 I PR D GETLL^LA7VSET(PR)
147 ;
148 W !!
149 D KDIR
150 S DIR("A")="Setup/update Logical Link",DIR(0)="YO"
151 D ^DIR
152 I $D(DIRUT) Q
153 I Y=1 D TCP^LA7VLL(REMOTE(LA7A),LA7VS)
154 ;
155 Q
156 ;
157 ;
158R1HLP ; HOST Lab(s) help
159 S DIR("?")="Enter a number between 1 and "_LA7CNT_"."
160 S DIR("?",1)="Enter a '"_LA7CNT_"' to create a new COLLECTION lab."
161 Q
162 ;
163 ;
164R2HLP ; HOST Lab Setup help
165 S DIR("?")="Enter a number between 1 and "_LA7CNT_". For new entries begin with '1. HOST Lab:'"
166 S DIR("?",1)="Enter a '1' to create the HL7 environment along with the Auto-Instrument"
167 S DIR("?",2)="and LA7 Message Configuration."
168 S DIR("?",3)="Enter a '2' to create the link between the COLLECTION and HOST labs."
169 S DIR("?",4)="Enter a '3' to configure the LA7 MESSAGE PARAMETER file."
170 Q
171 ;
172KDIR ;
173 K DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
174 Q
Note: See TracBrowser for help on using the repository browser.