LA7VSET1 ;DALOI/JMC - MENU TO SETUP VISN LABS ; 12/3/1997
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,55,46,64**;Sep 27, 1994
;
; Reference to HL LOGICAL LINK file (#870) supported by DBIA #1495, 1496, 2063
; Reference to PROTOCOL file (#101) supported by DBIA #872
; Reference to MAIL GROUP file (#3.8) supported by DBIA #2061
;
COLLECT ; Collection Lab Setup Menu
;
N LA7CNT,LA7,LA7P,LA7A,REMOTE
;
;
F D Q:'LA7A
. S REMOTE="COLLECTION Lab(s)"
. D RMTBLD,RMTHDR,RMTLST,KDIR
. W !! S DIR(0)="NO^1:"_LA7CNT
. D R1HLP
. D ^DIR
. I $D(DIRUT) S LA7A=0 Q
. S LA7A=Y D AEREMT
Q
;
;
RMTBLD ; Identify all COLLECTION labs using LA7 MESSAGE PARAMETER file (#62.48)
;
N LA7,LA74,SNAME,SNUM
S LA7CNT=1,(LA7,LA7P)="LA7V COLLECTION "
F S LA7=$O(^LAHM(62.48,"B",LA7)) Q:LA7=""!(LA7'[LA7P) D
. S SNUM=$P(LA7,"COLLECTION ",2)
. S LA74=$$FINDSITE^LA7VHLU2(SNUM,2,1) Q:LA74'>0
. S SNAME=$P($$NS^XUAF4(LA74),"^")
. S REMOTE(LA7CNT)=SNUM_U_SNAME_U_LA7_U_LA74,LA7CNT=LA7CNT+1
S REMOTE(LA7CNT)=""
Q
;
;
RMTHDR ; Collection setup header
;
W @IOF,! F X=1:1:79 W "-"
W !,?((80-$L(REMOTE))/2),REMOTE
W ! F X=1:1:79 W "-"
W !!
;
Q
;
;
RMTLST ;
S LA7CNT=1,LA7=0
F S LA7=$O(REMOTE(LA7)) Q:'LA7 D
. I REMOTE(LA7)="" Q
. W !,LA7,".",?5,$P(REMOTE(LA7),U,2)_" ("_$P(REMOTE(LA7),U,3)_")"
. S LA7CNT=LA7CNT+1
;
W !,LA7CNT,".",?5,"Add COLLECTION Lab"
;
Q
;
;
RMTHDR2 ;
N LA7624,LA76248,LA7870,LA7X
;
S LA7CNT=1
W !!,"1. COLLECTION Lab: ",?15,$P(REMOTE(LA7A),U,2)
W:$P(REMOTE(LA7A),U,2)'="" " (Uneditable)"
;
I $P(REMOTE(LA7A),U,2)="" Q
;
D LINK^HLUTIL3($P(REMOTE(LA7A),"^",4),.LA7X,"")
S LA7870=+$O(LA7X(0))
I 'LA7870 D
. S LA7870=+$$FIND1^DIC(870,"","OX","LA7V"_$P(REMOTE(LA7A),U))
. I 'LA7870 S LA7870=+$$FIND1^DIC(870,"","OX","LA7V "_$P(REMOTE(LA7A),U))
. I LA7870 S LA7X(LA7870)=$$GET1^DIQ(870,LA7870_",",.01)
S LA7CNT=2
W !,"2. Logical Link (TCP/IP): ",$G(LA7X(LA7870))
;
S LA76248=$$FIND1^DIC(62.48,"","OX","LA7V COLLECTION "_$P(REMOTE(LA7A),U)),LA7CNT=3
W !,"3. Message Configuration: ",$$GET1^DIQ(62.48,LA76248_",",.01)
Q
;
;
AEREMT ;
;
N CHA
;
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
. I CHA=1 D RLAB($P(REMOTE(LA7A),U))
. I CHA=2 D RLL
. I CHA=3 D LMC
Q
;
;
LMC ; Edit Lab message configuration file
;
N DIC,DA,DR,DIE,LA76248
;
S LA76248=$$FIND1^DIC(62.48,"","OX","LA7V COLLECTION "_$P(REMOTE(LA7A),U))
I LA76248<0 W !,"You have not entered a "_LAB_" lab." Q
S DA=LA76248,DIE="^LAHM(62.48,",DR="3;4;10;@20;20;I X'="""" S Y=""@20"""
D ^DIE
Q
;
;
RLAB(LRI) ;Add REMOTE LAB
;
N INST,LA7VER
;
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
;
I $P(REMOTE(LA7A),U)="" D
. N DIC,DA,DO
. S DIC="^DIC(4,",DIC(0)="AEMQZ"
. 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"")"
. D ^DIC Q:Y<1
. S INST=+Y
. I PRIMARY=INST!(INST=DUZ(2)) D Q
. . W !,"To add your Hospital as a COLLECTION site just add HOST sites."
. S REMOTE(LA7A+1)=REMOTE(LA7A)
. S REMOTE(LA7A)=$$RETFACID^LA7VHLU2(INST,2,1)_U_$P($$NS^XUAF4(INST),"^")_"^^"_INST
;
I $P(REMOTE(LA7A),U)="" S $P(REMOTE(LA7A),U,2)="" Q
;
I PRIMARY'=$P(REMOTE(LA7A),U) D
. S LA7VER=2.3
. I $$NVAF^LA7VHLU2($P(REMOTE(LA7A),"^",4))=1 S LA7VER=2.2
. D REMOTE^LA7VSTP(PRIMARY,PRSITE,$P(REMOTE(LA7A),U),$P(REMOTE(LA7A),U,2),LA7VER)
;
Q
;
;
;
RLL ; add/edit logical link
;
N HDR,PR,LA7LL
;
S HDR="Logical Link for transmissions to/from "_$P(REMOTE(LA7A),U,2)
W @IOF,! F X=1:1:79 W "-"
W !,?((80-$L(HDR))/2),HDR
W ! F X=1:1:79 W "-"
W !,?3,"Protocol",?40,"Logical Link",!,?3,"----------",?40,"---------------",!!
;
S PR=$O(^ORD(101,"B","LA7V Process Order from "_$P(REMOTE(LA7A),U),0))
I PR D GETLL^LA7VSET(PR)
;
S PR=$O(^ORD(101,"B","LA7V Send Results to "_$P(REMOTE(LA7A),U),0))
I PR D GETLL^LA7VSET(PR)
;
W !!
D KDIR
S DIR("A")="Setup/update Logical Link",DIR(0)="YO"
D ^DIR
I $D(DIRUT) Q
I Y=1 D TCP^LA7VLL(REMOTE(LA7A),LA7VS)
;
Q
;
;
R1HLP ; HOST Lab(s) help
S DIR("?")="Enter a number between 1 and "_LA7CNT_"."
S DIR("?",1)="Enter a '"_LA7CNT_"' to create a new COLLECTION lab."
Q
;
;
R2HLP ; HOST Lab Setup help
S DIR("?")="Enter a number between 1 and "_LA7CNT_". For new entries begin with '1. HOST Lab:'"
S DIR("?",1)="Enter a '1' to create the HL7 environment along with the Auto-Instrument"
S DIR("?",2)="and LA7 Message Configuration."
S DIR("?",3)="Enter a '2' to create the link between the COLLECTION and HOST labs."
S DIR("?",4)="Enter a '3' to configure the LA7 MESSAGE PARAMETER file."
Q
;
KDIR ;
K DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VSET1 4944 printed Apr 09, 2024@20:46:53 Page 2
LA7VSET1 ;DALOI/JMC - MENU TO SETUP VISN LABS ; 12/3/1997
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,55,46,64**;Sep 27, 1994
+2 ;
+3 ; Reference to HL LOGICAL LINK file (#870) supported by DBIA #1495, 1496, 2063
+4 ; Reference to PROTOCOL file (#101) supported by DBIA #872
+5 ; Reference to MAIL GROUP file (#3.8) supported by DBIA #2061
+6 ;
COLLECT ; Collection Lab Setup Menu
+1 ;
+2 NEW LA7CNT,LA7,LA7P,LA7A,REMOTE
+3 ;
+4 ;
+5 FOR
Begin DoDot:1
+6 SET REMOTE="COLLECTION Lab(s)"
+7 DO RMTBLD
DO RMTHDR
DO RMTLST
DO KDIR
+8 WRITE !!
SET DIR(0)="NO^1:"_LA7CNT
+9 DO R1HLP
+10 DO ^DIR
+11 IF $DATA(DIRUT)
SET LA7A=0
QUIT
+12 SET LA7A=Y
DO AEREMT
End DoDot:1
if 'LA7A
QUIT
+13 QUIT
+14 ;
+15 ;
RMTBLD ; Identify all COLLECTION labs using LA7 MESSAGE PARAMETER file (#62.48)
+1 ;
+2 NEW LA7,LA74,SNAME,SNUM
+3 SET LA7CNT=1
SET (LA7,LA7P)="LA7V COLLECTION "
+4 FOR
SET LA7=$ORDER(^LAHM(62.48,"B",LA7))
if LA7=""!(LA7'[LA7P)
QUIT
Begin DoDot:1
+5 SET SNUM=$PIECE(LA7,"COLLECTION ",2)
+6 SET LA74=$$FINDSITE^LA7VHLU2(SNUM,2,1)
if LA74'>0
QUIT
+7 SET SNAME=$PIECE($$NS^XUAF4(LA74),"^")
+8 SET REMOTE(LA7CNT)=SNUM_U_SNAME_U_LA7_U_LA74
SET LA7CNT=LA7CNT+1
End DoDot:1
+9 SET REMOTE(LA7CNT)=""
+10 QUIT
+11 ;
+12 ;
RMTHDR ; Collection setup header
+1 ;
+2 WRITE @IOF,!
FOR X=1:1:79
WRITE "-"
+3 WRITE !,?((80-$LENGTH(REMOTE))/2),REMOTE
+4 WRITE !
FOR X=1:1:79
WRITE "-"
+5 WRITE !!
+6 ;
+7 QUIT
+8 ;
+9 ;
RMTLST ;
+1 SET LA7CNT=1
SET LA7=0
+2 FOR
SET LA7=$ORDER(REMOTE(LA7))
if 'LA7
QUIT
Begin DoDot:1
+3 IF REMOTE(LA7)=""
QUIT
+4 WRITE !,LA7,".",?5,$PIECE(REMOTE(LA7),U,2)_" ("_$PIECE(REMOTE(LA7),U,3)_")"
+5 SET LA7CNT=LA7CNT+1
End DoDot:1
+6 ;
+7 WRITE !,LA7CNT,".",?5,"Add COLLECTION Lab"
+8 ;
+9 QUIT
+10 ;
+11 ;
RMTHDR2 ;
+1 NEW LA7624,LA76248,LA7870,LA7X
+2 ;
+3 SET LA7CNT=1
+4 WRITE !!,"1. COLLECTION Lab: ",?15,$PIECE(REMOTE(LA7A),U,2)
+5 if $PIECE(REMOTE(LA7A),U,2)'=""
WRITE " (Uneditable)"
+6 ;
+7 IF $PIECE(REMOTE(LA7A),U,2)=""
QUIT
+8 ;
+9 DO LINK^HLUTIL3($PIECE(REMOTE(LA7A),"^",4),.LA7X,"")
+10 SET LA7870=+$ORDER(LA7X(0))
+11 IF 'LA7870
Begin DoDot:1
+12 SET LA7870=+$$FIND1^DIC(870,"","OX","LA7V"_$PIECE(REMOTE(LA7A),U))
+13 IF 'LA7870
SET LA7870=+$$FIND1^DIC(870,"","OX","LA7V "_$PIECE(REMOTE(LA7A),U))
+14 IF LA7870
SET LA7X(LA7870)=$$GET1^DIQ(870,LA7870_",",.01)
End DoDot:1
+15 SET LA7CNT=2
+16 WRITE !,"2. Logical Link (TCP/IP): ",$GET(LA7X(LA7870))
+17 ;
+18 SET LA76248=$$FIND1^DIC(62.48,"","OX","LA7V COLLECTION "_$PIECE(REMOTE(LA7A),U))
SET LA7CNT=3
+19 WRITE !,"3. Message Configuration: ",$$GET1^DIQ(62.48,LA76248_",",.01)
+20 QUIT
+21 ;
+22 ;
AEREMT ;
+1 ;
+2 NEW CHA
+3 ;
+4 FOR
SET REMOTE="COLLECTION Lab Setup"
DO RMTHDR
DO RMTHDR2
DO KDIR
WRITE !!
SET DIR(0)="NO^1:"_LA7CNT
DO R2HLP
DO ^DIR
SET CHA=Y
if CHA>0
Begin DoDot:1
+5 IF CHA=1
DO RLAB($PIECE(REMOTE(LA7A),U))
+6 IF CHA=2
DO RLL
+7 IF CHA=3
DO LMC
End DoDot:1
if +CHA'>0
QUIT
+8 QUIT
+9 ;
+10 ;
LMC ; Edit Lab message configuration file
+1 ;
+2 NEW DIC,DA,DR,DIE,LA76248
+3 ;
+4 SET LA76248=$$FIND1^DIC(62.48,"","OX","LA7V COLLECTION "_$PIECE(REMOTE(LA7A),U))
+5 IF LA76248<0
WRITE !,"You have not entered a "_LAB_" lab."
QUIT
+6 SET DA=LA76248
SET DIE="^LAHM(62.48,"
SET DR="3;4;10;@20;20;I X'="""" S Y=""@20"""
+7 DO ^DIE
+8 QUIT
+9 ;
+10 ;
RLAB(LRI) ;Add REMOTE LAB
+1 ;
+2 NEW INST,LA7VER
+3 ;
+4 IF $PIECE(REMOTE(LA7A),U)'=""
DO KDIR
SET DIR("A")="Are you sure you want to update the "_$PIECE(REMOTE(LA7A),U,2)_" interface"
SET DIR(0)="Y0"
DO ^DIR
if +Y'>0
QUIT
+5 ;
+6 IF $PIECE(REMOTE(LA7A),U)=""
Begin DoDot:1
+7 NEW DIC,DA,DO
+8 SET DIC="^DIC(4,"
SET DIC(0)="AEMQZ"
+9 SET 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"")"
+10 DO ^DIC
if Y<1
QUIT
+11 SET INST=+Y
+12 IF PRIMARY=INST!(INST=DUZ(2))
Begin DoDot:2
+13 WRITE !,"To add your Hospital as a COLLECTION site just add HOST sites."
End DoDot:2
QUIT
+14 SET REMOTE(LA7A+1)=REMOTE(LA7A)
+15 SET REMOTE(LA7A)=$$RETFACID^LA7VHLU2(INST,2,1)_U_$PIECE($$NS^XUAF4(INST),"^")_"^^"_INST
End DoDot:1
+16 ;
+17 IF $PIECE(REMOTE(LA7A),U)=""
SET $PIECE(REMOTE(LA7A),U,2)=""
QUIT
+18 ;
+19 IF PRIMARY'=$PIECE(REMOTE(LA7A),U)
Begin DoDot:1
+20 SET LA7VER=2.3
+21 IF $$NVAF^LA7VHLU2($PIECE(REMOTE(LA7A),"^",4))=1
SET LA7VER=2.2
+22 DO REMOTE^LA7VSTP(PRIMARY,PRSITE,$PIECE(REMOTE(LA7A),U),$PIECE(REMOTE(LA7A),U,2),LA7VER)
End DoDot:1
+23 ;
+24 QUIT
+25 ;
+26 ;
+27 ;
RLL ; add/edit logical link
+1 ;
+2 NEW HDR,PR,LA7LL
+3 ;
+4 SET HDR="Logical Link for transmissions to/from "_$PIECE(REMOTE(LA7A),U,2)
+5 WRITE @IOF,!
FOR X=1:1:79
WRITE "-"
+6 WRITE !,?((80-$LENGTH(HDR))/2),HDR
+7 WRITE !
FOR X=1:1:79
WRITE "-"
+8 WRITE !,?3,"Protocol",?40,"Logical Link",!,?3,"----------",?40,"---------------",!!
+9 ;
+10 SET PR=$ORDER(^ORD(101,"B","LA7V Process Order from "_$PIECE(REMOTE(LA7A),U),0))
+11 IF PR
DO GETLL^LA7VSET(PR)
+12 ;
+13 SET PR=$ORDER(^ORD(101,"B","LA7V Send Results to "_$PIECE(REMOTE(LA7A),U),0))
+14 IF PR
DO GETLL^LA7VSET(PR)
+15 ;
+16 WRITE !!
+17 DO KDIR
+18 SET DIR("A")="Setup/update Logical Link"
SET DIR(0)="YO"
+19 DO ^DIR
+20 IF $DATA(DIRUT)
QUIT
+21 IF Y=1
DO TCP^LA7VLL(REMOTE(LA7A),LA7VS)
+22 ;
+23 QUIT
+24 ;
+25 ;
R1HLP ; HOST Lab(s) help
+1 SET DIR("?")="Enter a number between 1 and "_LA7CNT_"."
+2 SET DIR("?",1)="Enter a '"_LA7CNT_"' to create a new COLLECTION lab."
+3 QUIT
+4 ;
+5 ;
R2HLP ; HOST Lab Setup help
+1 SET DIR("?")="Enter a number between 1 and "_LA7CNT_". For new entries begin with '1. HOST Lab:'"
+2 SET DIR("?",1)="Enter a '1' to create the HL7 environment along with the Auto-Instrument"
+3 SET DIR("?",2)="and LA7 Message Configuration."
+4 SET DIR("?",3)="Enter a '2' to create the link between the COLLECTION and HOST labs."
+5 SET DIR("?",4)="Enter a '3' to configure the LA7 MESSAGE PARAMETER file."
+6 QUIT
+7 ;
KDIR ;
+1 KILL DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+2 QUIT
