| 1 | LA7VSET1 ;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 | ; | 
|---|
| 8 | COLLECT ; 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 | ; | 
|---|
| 24 | RMTBLD ; 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 | ; | 
|---|
| 37 | RMTHDR ; 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 | ; | 
|---|
| 47 | RMTLST ; | 
|---|
| 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 | ; | 
|---|
| 59 | RMTHDR2 ; | 
|---|
| 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 | ; | 
|---|
| 82 | AEREMT ; | 
|---|
| 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 | ; | 
|---|
| 93 | LMC ; 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 | ; | 
|---|
| 104 | RLAB(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 | ; | 
|---|
| 132 | RLL ; 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 | ; | 
|---|
| 158 | R1HLP ; 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 | ; | 
|---|
| 164 | R2HLP ; 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 | ; | 
|---|
| 172 | KDIR ; | 
|---|
| 173 | K DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y | 
|---|
| 174 | Q | 
|---|