LA7VSET ;DALOI/JMC - MENU TO SETUP VISN LABS ;11/15/11 9:13
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,55,46,64,74**;Sep 27, 1994;Build 229
;
; 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
;
D CONV
;
N LA76248,LA7629,LA7VNVC,PRIMARY,PRSITE,HDR,LAB,HOST,REMOTE,LRY,LRX,LA7VS,NAME
;
S LA7VS=$$PRIM^VASITE(DT)
I $G(LA7VS)'="" D
. S LA7VS=$$SITE^VASITE(DT,LA7VS)
. S PRIMARY=$P(LA7VS,U,3),PRSITE=$P(LA7VS,U,2)
;
I $G(PRIMARY)="" W !!,"No Primary Site is defined!!!!",!! R !,"Press RETURN to continue: ",X:DTIME Q
;
S HDR="LEDI Setup"
S HDR(1)="Add/Edit HOST Lab",HDR(2)="Add/Edit COLLECTION Lab"
F S LAB=$$MAIN Q:LAB="" D @LAB
;
K DIE,DA,DR,DO,DIC
;
Q
;
MAIN() ; Display the main LEDI setup screen
N HDRCNT,HDRA
W @IOF,! F X=1:1:79 W "-"
W !,?((80-$L(HDR))/2),HDR
W ! F X=1:1:79 W "-"
W !
W !,"COLLECTION Labs: Use option #1 to setup HOST labs."
W !," HOST Labs : Use option #2 to setup COLLECTION labs."
W !!
S HDRCNT=0
F S HDRCNT=$O(HDR(HDRCNT)) Q:'HDRCNT W !,HDRCNT,".",?5,HDR(HDRCNT)
D KDIR
W !!
S DIR(0)="NO^1:2"
D MHLP,^DIR
S HDRA=$S(Y=1:"HOST",Y=2:"REMOTE",1:"")
D KDIR
Q HDRA
;
;
KDIR ; kill all DIR variables
K DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
Q
;
;
HOST ; HOST Lab Setup Menu
;
N LA7CNT,LA7,LA7P,SNUM,SNAME,HOST,LA7A
;
F D Q:'LA7A
. D HOSTBLD,HSTHDR,HOSTLST,KDIR
. W !! S DIR(0)="NO^1:"_LA7CNT
. D H1HLP,^DIR
. I $D(DIRUT) S LA7A=0 Q
. S LA7A=Y D AEHOST
K SNAME
Q
;
;
HOSTBLD ; Build list of host facilities.
; Identify all HOST labs using LA7 MESSAGE PARAMETER file (#62.48)
;
N LA7,LA74,LA76248,LA7629,SNAME,SNUM
;
K HOST
S LA7CNT=1,(LA7,LA7P)="LA7V HOST "
F S LA7=$O(^LAHM(62.48,"B",LA7)) Q:LA7=""!(LA7'[LA7P) D
. S SNUM=$P(LA7,"HOST ",2)
. S LA74=$$FINDSITE^LA7VHLU2(SNUM,1,1) Q:LA74'>0
. S SNAME=$P($$NS^XUAF4(LA74),"^")
. S HOST(LA7CNT)=SNUM_U_SNAME_U_LA7_U_LA74,LA7CNT=LA7CNT+1
S HOST(LA7CNT)=""
;
Q
;
;
HSTHDR ; HOST setup header
S HOST="HOST Lab(s)"
W @IOF,! F X=1:1:79 W "-"
W !,?((80-$L(HOST))/2),HOST
W ! F X=1:1:79 W "-"
W !!
Q
;
;
HOSTLST ;
S LA7CNT=1,LA7=0
F S LA7=$O(HOST(LA7)) Q:'LA7 I HOST(LA7)'="" W !,LA7,".",?5,$P(HOST(LA7),U,2)_" ("_$P(HOST(LA7),U,3)_")" S LA7CNT=LA7CNT+1
W !,LA7CNT,".",?5,"Add HOST Lab"
Q
;
AEHOST ;
N CHA,UI
F S HOST="HOST Lab Setup" D HSTHDR,HSTHDR2,KDIR W !! S DIR(0)="NO^1:"_LA7CNT D H2HLP D ^DIR S CHA=Y D:CHA>0 Q:+CHA'>0
. I CHA=1 D HLAB($P(HOST(LA7A),U))
. I CHA=2 D HLL
. I CHA=3 D LMC
. I CHA=4 D CHTST
D KDIR
Q
;
;
HSTHDR2 ;
N LA7624,LA76248,LA7870,LA7X
;
S LA7CNT=1
W !!,"1. HOST Lab: ",?15,$P(HOST(LA7A),U,2)
W:$P(HOST(LA7A),U,2)'="" " (Uneditable)"
;
I $P(HOST(LA7A),U,2)="" Q
;
D LINK^HLUTIL3($P(HOST(LA7A),"^",4),.LA7X,"")
S LA7870=+$O(LA7X(0))
I 'LA7870 D
. S LA7870=+$$FIND1^DIC(870,"","OX","LA7V"_$P(HOST(LA7A),U))
. I 'LA7870 S LA7870=+$$FIND1^DIC(870,"","OX","LA7V "_$P(HOST(LA7A),U))
. I LA7870 S LA7X(LA7870)=$$GET1^DIQ(870,LA7870_",",.01)
S LA7CNT=2
W !,"2. Logical Link: ",$G(LA7X(LA7870))
;
S LA76248=$$FIND1^DIC(62.48,"","OX","LA7V HOST "_$P(HOST(LA7A),U)),LA7CNT=3
W !,"3. Message Configuration: ",$$GET1^DIQ(62.48,LA76248_",",.01)
;
S LA7624=$$FIND1^DIC(62.4,"","OX","LA7V HOST "_$P(HOST(LA7A),U)),LA7CNT=4
W !,"4. Auto Instrument: ",$$GET1^DIQ(62.4,LA7624_",",.01)
;
Q
;
;
LMC ; Edit lab message configuration file.
;
N DIC,DA,DR,DIE
;
S X="LA7V HOST "_$P(@LAB@(LA7A),U),DIC(0)="EMX",DIC="^LAHM(62.48,"
D ^DIC
I +Y<0 W !,"You have not entered a "_LAB_" lab." Q
;
S DA=+Y,DIE="^LAHM(62.48,",DR="3;4;10;11////10;@20;20;I X'="""" S Y=""@20"""
D ^DIE
;
Q
;
;
HLAB(LRI) ;Add Host LAB
;
N INST,LA7VNVC,LA7629,LA7VER,LA7X
;
I $P(HOST(LA7A),U)'="" D KDIR S DIR("A")="Are you sure you want to update the "_$P(HOST(LA7A),U,2)_" interface",DIR(0)="Y0" D ^DIR Q:+Y'>0
;
I $P(HOST(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 HOST site just add COLLECTION sites."
. S HOST(LA7A+1)=HOST(LA7A)
. S HOST(LA7A)=$$RETFACID^LA7VHLU2(INST,1,1)_U_$P($$NS^XUAF4(INST),"^")_"^^"_INST
;
I $P(HOST(LA7A),U)="" S $P(HOST(LA7A),U,2)="" Q
;
I PRIMARY'=$P(HOST(LA7A),U) D
. S LA7VER=2.3
. I $$NVAF^LA7VHLU2($P(HOST(LA7A),"^",4))=1 S LA7VER=2.2
. D HOST^LA7VSTP(PRIMARY,PRSITE,$P(HOST(LA7A),U),$P(HOST(LA7A),U,2),LA7VER)
;
Q
;
;
HLL ;add/edit logical link
;
N HDR,PR,LA7LL
S HDR="Logical Link for transmissions to/from "_$P(HOST(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,"---------------"
W !!
S PR=$O(^ORD(101,"B","LA7V Process Results from "_$P(HOST(LA7A),U),0))
I PR D GETLL(PR)
;
S PR=$O(^ORD(101,"B","LA7V Send Order to "_$P(HOST(LA7A),U),0))
I PR D GETLL(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(HOST(LA7A),LA7VS)
;
Q
;
;
CHTST ;Enter CHEM Test into the AUTO INSTRUMENT file (#62.4)
;
N DA,DIC,DIE,DR,AI,LA7624
;
S (AI,X)="LA7V HOST "_$P(HOST(LA7A),U)
S DIC(0)="QEM",DIC="^LAB(62.4," D ^DIC
I +Y<1 Q
S LA7624=+Y
;
W !!,"AUTOMATED INSTRUMENT: ",$P(^LAB(62.4,LA7624,0),U)
;
L +^LAB(62.4,LA7624):1
I '$T W !,?5,"Another user is editing this entry." Q
;
S DA=LA7624,DIE=DIC,DR="3;10;11;12;18;107"
D ^DIE
W !,"Add Chem Tests to the "_AI_" Automated Instrument for "_$P(HOST(LA7A),U,2)_".",!!
D CHSET
;
L -^LAB(62.4,LA7624)
;
Q
;
;
CHSET ; Edit chem test multiple for selected fields
; Entry locked from above.
N DA,DO,DIC,DIE,DLAYGO,DR,LA7NLT,LA7Y
;
S DA(1)=LA7624,DLAYGO=62.4
S DIC="^LAB(62.4,"_DA(1)_",3,",DIC(0)="AELMQZ",DIC("DR")=".01",DIC("P")=$P(^DD(62.4,30,0),U,2)
F D Q:LA7Y<1
. D ^DIC S LA7Y=Y Q:LA7Y<1
. S DIE=DIC
. N DA,DIC,DLAYGO ; Protect variables in case changed in DIE call.
. S LA7NLT=$$GET1^DIQ(64,+$P($G(^LAB(60,$P(LA7Y,U,2),64)),U,2)_",",1)
. S DA=+LA7Y,DA(1)=LA7624
. S DR=".01;6//"_LA7NLT_";14;16;18//YES;19;22//NO"
. D ^DIE
. W !
Q
;
;
REMOTE ;COLLECTION Lab Setup Menu
;
D COLLECT^LA7VSET1
Q
;
;
MHLP ;Main help
S DIR("?")=" "
S DIR("?",1)="Option #1 will setup HOST site auto-instruments, HOST site message"
S DIR("?",2)="configuration, and HOST and COLLECTION sites HL7 environment."
S DIR("?",3)=" "
S DIR("?",4)="Option #2 will setup COLLECTION site auto-instruments, COLLECTION site message"
S DIR("?",5)="configuration, and COLLECTION and HOST sites HL7 environment."
S DIR("?",6)=" "
S DIR("?",7)="Option #1 and #2 SHOULD be used by sites that are both a HOST"
S DIR("?",8)="and a COLLECTION site."
Q
;
;
H1HLP ;HOST Lab(s) help
S DIR("?")="Enter a number between 1 and "_LA7CNT_"."
S DIR("?",1)="Enter a '"_LA7CNT_"' to create a new HOST lab."
Q
;
;
H2HLP ;HOST Lab Setup help
S DIR("?")=" "
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 HOST and COLLECTION labs."
S DIR("?",5)="Enter a '3' to configure the LA7 MESSAGE PARAMETER file."
S DIR("?",4)="Enter a '4' to identify the list of tests you expect back from the HOST lab."
Q
;
;
CONV ;Convert #62.4 and #62.48 from REMOTE to COLLECTION (File #771 will remain REMOTE).
N RMT,RMT1,UPDT,IEN
K DA,DR,DIE
S DIE="^LAB(62.4,"
S RMT1="LA7V REMOTE ",RMT=RMT1
F S RMT=$O(^LAB(62.4,"B",RMT)) Q:RMT=""!(RMT'[RMT1) D
. S IEN=$O(^LAB(62.4,"B",RMT,0))
. S NAME="LA7V COLLECTION"_$P($P(^LAB(62.4,IEN,0),U),"REMOTE",2)
. S DA=IEN,DR=".01///"_NAME
. W !,"Renaming Auto-Instrument "_$P(^LAB(62.4,IEN,0),U)_" to "_NAME
. D ^DIE
. S UPDT=1
K DA,DR,DIE
S DIE="^LAHM(62.48,"
S RMT1="LA7V REMOTE ",RMT=RMT1
F S RMT=$O(^LAHM(62.48,"B",RMT)) Q:RMT=""!(RMT'[RMT1) D
. S IEN=$O(^LAHM(62.48,"B",RMT,0))
. S NAME="LA7V COLLECTION"_$P($P(^LAHM(62.48,IEN,0),U),"REMOTE",2)
. S DA=IEN,DR=".01///"_NAME
. W !,"Renaming LA7 Message Configuration "_$P(^LAHM(62.48,IEN,0),U)_" to "_NAME
. D ^DIE
. S UPDT=1
I $G(UPDT)=1 D
. N DIR,DIRUT
. W !!,"For consistency and clarity the above Auto-Instrument names"
. W !,"and Message Configurations have been changed from REMOTE to COLLECTION."
. S DIR(0)="E" D ^DIR
Q
;
;
GETLL(LA7X) ; Get Lower Level Protocol information for displaying
; Call with LA7X = ien of file #101 protocol
;
; Called from above and LA7VSET1
;
N LA7Y
;
D GETS^DIQ(101,LA7X_",",".01;770.7","IE","LA7Y")
;
W !,?3,$G(LA7Y(101,LA7X_",",.01,"E"))
W ?40,$G(LA7Y(101,LA7X_",",770.7,"E"))
I $G(LA7Y(101,LA7X_",",770.7,"I")) W " ("_$$GET1^DIQ(870,+LA7Y(101,LA7X_",",770.7,"I")_",",2)_")"
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VSET 9244 printed Apr 09, 2024@20:49:26 Page 2
LA7VSET ;DALOI/JMC - MENU TO SETUP VISN LABS ;11/15/11 9:13
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,55,46,64,74**;Sep 27, 1994;Build 229
+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 ;
+7 DO CONV
+8 ;
+9 NEW LA76248,LA7629,LA7VNVC,PRIMARY,PRSITE,HDR,LAB,HOST,REMOTE,LRY,LRX,LA7VS,NAME
+10 ;
+11 SET LA7VS=$$PRIM^VASITE(DT)
+12 IF $GET(LA7VS)'=""
Begin DoDot:1
+13 SET LA7VS=$$SITE^VASITE(DT,LA7VS)
+14 SET PRIMARY=$PIECE(LA7VS,U,3)
SET PRSITE=$PIECE(LA7VS,U,2)
End DoDot:1
+15 ;
+16 IF $GET(PRIMARY)=""
WRITE !!,"No Primary Site is defined!!!!",!!
READ !,"Press RETURN to continue: ",X:DTIME
QUIT
+17 ;
+18 SET HDR="LEDI Setup"
+19 SET HDR(1)="Add/Edit HOST Lab"
SET HDR(2)="Add/Edit COLLECTION Lab"
+20 FOR
SET LAB=$$MAIN
if LAB=""
QUIT
DO @LAB
+21 ;
+22 KILL DIE,DA,DR,DO,DIC
+23 ;
+24 QUIT
+25 ;
MAIN() ; Display the main LEDI setup screen
+1 NEW HDRCNT,HDRA
+2 WRITE @IOF,!
FOR X=1:1:79
WRITE "-"
+3 WRITE !,?((80-$LENGTH(HDR))/2),HDR
+4 WRITE !
FOR X=1:1:79
WRITE "-"
+5 WRITE !
+6 WRITE !,"COLLECTION Labs: Use option #1 to setup HOST labs."
+7 WRITE !," HOST Labs : Use option #2 to setup COLLECTION labs."
+8 WRITE !!
+9 SET HDRCNT=0
+10 FOR
SET HDRCNT=$ORDER(HDR(HDRCNT))
if 'HDRCNT
QUIT
WRITE !,HDRCNT,".",?5,HDR(HDRCNT)
+11 DO KDIR
+12 WRITE !!
+13 SET DIR(0)="NO^1:2"
+14 DO MHLP
DO ^DIR
+15 SET HDRA=$SELECT(Y=1:"HOST",Y=2:"REMOTE",1:"")
+16 DO KDIR
+17 QUIT HDRA
+18 ;
+19 ;
KDIR ; kill all DIR variables
+1 KILL DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+2 QUIT
+3 ;
+4 ;
HOST ; HOST Lab Setup Menu
+1 ;
+2 NEW LA7CNT,LA7,LA7P,SNUM,SNAME,HOST,LA7A
+3 ;
+4 FOR
Begin DoDot:1
+5 DO HOSTBLD
DO HSTHDR
DO HOSTLST
DO KDIR
+6 WRITE !!
SET DIR(0)="NO^1:"_LA7CNT
+7 DO H1HLP
DO ^DIR
+8 IF $DATA(DIRUT)
SET LA7A=0
QUIT
+9 SET LA7A=Y
DO AEHOST
End DoDot:1
if 'LA7A
QUIT
+10 KILL SNAME
+11 QUIT
+12 ;
+13 ;
HOSTBLD ; Build list of host facilities.
+1 ; Identify all HOST labs using LA7 MESSAGE PARAMETER file (#62.48)
+2 ;
+3 NEW LA7,LA74,LA76248,LA7629,SNAME,SNUM
+4 ;
+5 KILL HOST
+6 SET LA7CNT=1
SET (LA7,LA7P)="LA7V HOST "
+7 FOR
SET LA7=$ORDER(^LAHM(62.48,"B",LA7))
if LA7=""!(LA7'[LA7P)
QUIT
Begin DoDot:1
+8 SET SNUM=$PIECE(LA7,"HOST ",2)
+9 SET LA74=$$FINDSITE^LA7VHLU2(SNUM,1,1)
if LA74'>0
QUIT
+10 SET SNAME=$PIECE($$NS^XUAF4(LA74),"^")
+11 SET HOST(LA7CNT)=SNUM_U_SNAME_U_LA7_U_LA74
SET LA7CNT=LA7CNT+1
End DoDot:1
+12 SET HOST(LA7CNT)=""
+13 ;
+14 QUIT
+15 ;
+16 ;
HSTHDR ; HOST setup header
+1 SET HOST="HOST Lab(s)"
+2 WRITE @IOF,!
FOR X=1:1:79
WRITE "-"
+3 WRITE !,?((80-$LENGTH(HOST))/2),HOST
+4 WRITE !
FOR X=1:1:79
WRITE "-"
+5 WRITE !!
+6 QUIT
+7 ;
+8 ;
HOSTLST ;
+1 SET LA7CNT=1
SET LA7=0
+2 FOR
SET LA7=$ORDER(HOST(LA7))
if 'LA7
QUIT
IF HOST(LA7)'=""
WRITE !,LA7,".",?5,$PIECE(HOST(LA7),U,2)_" ("_$PIECE(HOST(LA7),U,3)_")"
SET LA7CNT=LA7CNT+1
+3 WRITE !,LA7CNT,".",?5,"Add HOST Lab"
+4 QUIT
+5 ;
AEHOST ;
+1 NEW CHA,UI
+2 FOR
SET HOST="HOST Lab Setup"
DO HSTHDR
DO HSTHDR2
DO KDIR
WRITE !!
SET DIR(0)="NO^1:"_LA7CNT
DO H2HLP
DO ^DIR
SET CHA=Y
if CHA>0
Begin DoDot:1
+3 IF CHA=1
DO HLAB($PIECE(HOST(LA7A),U))
+4 IF CHA=2
DO HLL
+5 IF CHA=3
DO LMC
+6 IF CHA=4
DO CHTST
End DoDot:1
if +CHA'>0
QUIT
+7 DO KDIR
+8 QUIT
+9 ;
+10 ;
HSTHDR2 ;
+1 NEW LA7624,LA76248,LA7870,LA7X
+2 ;
+3 SET LA7CNT=1
+4 WRITE !!,"1. HOST Lab: ",?15,$PIECE(HOST(LA7A),U,2)
+5 if $PIECE(HOST(LA7A),U,2)'=""
WRITE " (Uneditable)"
+6 ;
+7 IF $PIECE(HOST(LA7A),U,2)=""
QUIT
+8 ;
+9 DO LINK^HLUTIL3($PIECE(HOST(LA7A),"^",4),.LA7X,"")
+10 SET LA7870=+$ORDER(LA7X(0))
+11 IF 'LA7870
Begin DoDot:1
+12 SET LA7870=+$$FIND1^DIC(870,"","OX","LA7V"_$PIECE(HOST(LA7A),U))
+13 IF 'LA7870
SET LA7870=+$$FIND1^DIC(870,"","OX","LA7V "_$PIECE(HOST(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: ",$GET(LA7X(LA7870))
+17 ;
+18 SET LA76248=$$FIND1^DIC(62.48,"","OX","LA7V HOST "_$PIECE(HOST(LA7A),U))
SET LA7CNT=3
+19 WRITE !,"3. Message Configuration: ",$$GET1^DIQ(62.48,LA76248_",",.01)
+20 ;
+21 SET LA7624=$$FIND1^DIC(62.4,"","OX","LA7V HOST "_$PIECE(HOST(LA7A),U))
SET LA7CNT=4
+22 WRITE !,"4. Auto Instrument: ",$$GET1^DIQ(62.4,LA7624_",",.01)
+23 ;
+24 QUIT
+25 ;
+26 ;
LMC ; Edit lab message configuration file.
+1 ;
+2 NEW DIC,DA,DR,DIE
+3 ;
+4 SET X="LA7V HOST "_$PIECE(@LAB@(LA7A),U)
SET DIC(0)="EMX"
SET DIC="^LAHM(62.48,"
+5 DO ^DIC
+6 IF +Y<0
WRITE !,"You have not entered a "_LAB_" lab."
QUIT
+7 ;
+8 SET DA=+Y
SET DIE="^LAHM(62.48,"
SET DR="3;4;10;11////10;@20;20;I X'="""" S Y=""@20"""
+9 DO ^DIE
+10 ;
+11 QUIT
+12 ;
+13 ;
HLAB(LRI) ;Add Host LAB
+1 ;
+2 NEW INST,LA7VNVC,LA7629,LA7VER,LA7X
+3 ;
+4 IF $PIECE(HOST(LA7A),U)'=""
DO KDIR
SET DIR("A")="Are you sure you want to update the "_$PIECE(HOST(LA7A),U,2)_" interface"
SET DIR(0)="Y0"
DO ^DIR
if +Y'>0
QUIT
+5 ;
+6 IF $PIECE(HOST(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 HOST site just add COLLECTION sites."
End DoDot:2
QUIT
+14 SET HOST(LA7A+1)=HOST(LA7A)
+15 SET HOST(LA7A)=$$RETFACID^LA7VHLU2(INST,1,1)_U_$PIECE($$NS^XUAF4(INST),"^")_"^^"_INST
End DoDot:1
+16 ;
+17 IF $PIECE(HOST(LA7A),U)=""
SET $PIECE(HOST(LA7A),U,2)=""
QUIT
+18 ;
+19 IF PRIMARY'=$PIECE(HOST(LA7A),U)
Begin DoDot:1
+20 SET LA7VER=2.3
+21 IF $$NVAF^LA7VHLU2($PIECE(HOST(LA7A),"^",4))=1
SET LA7VER=2.2
+22 DO HOST^LA7VSTP(PRIMARY,PRSITE,$PIECE(HOST(LA7A),U),$PIECE(HOST(LA7A),U,2),LA7VER)
End DoDot:1
+23 ;
+24 QUIT
+25 ;
+26 ;
HLL ;add/edit logical link
+1 ;
+2 NEW HDR,PR,LA7LL
+3 SET HDR="Logical Link for transmissions to/from "_$PIECE(HOST(LA7A),U,2)
+4 WRITE @IOF,!
FOR X=1:1:79
WRITE "-"
+5 WRITE !,?((80-$LENGTH(HDR))/2),HDR
+6 WRITE !
FOR X=1:1:79
WRITE "-"
+7 WRITE !,?3,"Protocol",?40,"Logical Link",!,?3,"----------",?40,"---------------"
+8 WRITE !!
+9 SET PR=$ORDER(^ORD(101,"B","LA7V Process Results from "_$PIECE(HOST(LA7A),U),0))
+10 IF PR
DO GETLL(PR)
+11 ;
+12 SET PR=$ORDER(^ORD(101,"B","LA7V Send Order to "_$PIECE(HOST(LA7A),U),0))
+13 IF PR
DO GETLL(PR)
+14 ;
+15 WRITE !!
+16 DO KDIR
+17 SET DIR("A")="Setup/update Logical Link"
SET DIR(0)="YO"
+18 DO ^DIR
+19 IF $DATA(DIRUT)
QUIT
+20 IF Y=1
DO TCP^LA7VLL(HOST(LA7A),LA7VS)
+21 ;
+22 QUIT
+23 ;
+24 ;
CHTST ;Enter CHEM Test into the AUTO INSTRUMENT file (#62.4)
+1 ;
+2 NEW DA,DIC,DIE,DR,AI,LA7624
+3 ;
+4 SET (AI,X)="LA7V HOST "_$PIECE(HOST(LA7A),U)
+5 SET DIC(0)="QEM"
SET DIC="^LAB(62.4,"
DO ^DIC
+6 IF +Y<1
QUIT
+7 SET LA7624=+Y
+8 ;
+9 WRITE !!,"AUTOMATED INSTRUMENT: ",$PIECE(^LAB(62.4,LA7624,0),U)
+10 ;
+11 LOCK +^LAB(62.4,LA7624):1
+12 IF '$TEST
WRITE !,?5,"Another user is editing this entry."
QUIT
+13 ;
+14 SET DA=LA7624
SET DIE=DIC
SET DR="3;10;11;12;18;107"
+15 DO ^DIE
+16 WRITE !,"Add Chem Tests to the "_AI_" Automated Instrument for "_$PIECE(HOST(LA7A),U,2)_".",!!
+17 DO CHSET
+18 ;
+19 LOCK -^LAB(62.4,LA7624)
+20 ;
+21 QUIT
+22 ;
+23 ;
CHSET ; Edit chem test multiple for selected fields
+1 ; Entry locked from above.
+2 NEW DA,DO,DIC,DIE,DLAYGO,DR,LA7NLT,LA7Y
+3 ;
+4 SET DA(1)=LA7624
SET DLAYGO=62.4
+5 SET DIC="^LAB(62.4,"_DA(1)_",3,"
SET DIC(0)="AELMQZ"
SET DIC("DR")=".01"
SET DIC("P")=$PIECE(^DD(62.4,30,0),U,2)
+6 FOR
Begin DoDot:1
+7 DO ^DIC
SET LA7Y=Y
if LA7Y<1
QUIT
+8 SET DIE=DIC
+9 ; Protect variables in case changed in DIE call.
NEW DA,DIC,DLAYGO
+10 SET LA7NLT=$$GET1^DIQ(64,+$PIECE($GET(^LAB(60,$PIECE(LA7Y,U,2),64)),U,2)_",",1)
+11 SET DA=+LA7Y
SET DA(1)=LA7624
+12 SET DR=".01;6//"_LA7NLT_";14;16;18//YES;19;22//NO"
+13 DO ^DIE
+14 WRITE !
End DoDot:1
if LA7Y<1
QUIT
+15 QUIT
+16 ;
+17 ;
REMOTE ;COLLECTION Lab Setup Menu
+1 ;
+2 DO COLLECT^LA7VSET1
+3 QUIT
+4 ;
+5 ;
MHLP ;Main help
+1 SET DIR("?")=" "
+2 SET DIR("?",1)="Option #1 will setup HOST site auto-instruments, HOST site message"
+3 SET DIR("?",2)="configuration, and HOST and COLLECTION sites HL7 environment."
+4 SET DIR("?",3)=" "
+5 SET DIR("?",4)="Option #2 will setup COLLECTION site auto-instruments, COLLECTION site message"
+6 SET DIR("?",5)="configuration, and COLLECTION and HOST sites HL7 environment."
+7 SET DIR("?",6)=" "
+8 SET DIR("?",7)="Option #1 and #2 SHOULD be used by sites that are both a HOST"
+9 SET DIR("?",8)="and a COLLECTION site."
+10 QUIT
+11 ;
+12 ;
H1HLP ;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 HOST lab."
+3 QUIT
+4 ;
+5 ;
H2HLP ;HOST Lab Setup help
+1 SET DIR("?")=" "
+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 HOST and COLLECTION labs."
+5 SET DIR("?",5)="Enter a '3' to configure the LA7 MESSAGE PARAMETER file."
+6 SET DIR("?",4)="Enter a '4' to identify the list of tests you expect back from the HOST lab."
+7 QUIT
+8 ;
+9 ;
CONV ;Convert #62.4 and #62.48 from REMOTE to COLLECTION (File #771 will remain REMOTE).
+1 NEW RMT,RMT1,UPDT,IEN
+2 KILL DA,DR,DIE
+3 SET DIE="^LAB(62.4,"
+4 SET RMT1="LA7V REMOTE "
SET RMT=RMT1
+5 FOR
SET RMT=$ORDER(^LAB(62.4,"B",RMT))
if RMT=""!(RMT'[RMT1)
QUIT
Begin DoDot:1
+6 SET IEN=$ORDER(^LAB(62.4,"B",RMT,0))
+7 SET NAME="LA7V COLLECTION"_$PIECE($PIECE(^LAB(62.4,IEN,0),U),"REMOTE",2)
+8 SET DA=IEN
SET DR=".01///"_NAME
+9 WRITE !,"Renaming Auto-Instrument "_$PIECE(^LAB(62.4,IEN,0),U)_" to "_NAME
+10 DO ^DIE
+11 SET UPDT=1
End DoDot:1
+12 KILL DA,DR,DIE
+13 SET DIE="^LAHM(62.48,"
+14 SET RMT1="LA7V REMOTE "
SET RMT=RMT1
+15 FOR
SET RMT=$ORDER(^LAHM(62.48,"B",RMT))
if RMT=""!(RMT'[RMT1)
QUIT
Begin DoDot:1
+16 SET IEN=$ORDER(^LAHM(62.48,"B",RMT,0))
+17 SET NAME="LA7V COLLECTION"_$PIECE($PIECE(^LAHM(62.48,IEN,0),U),"REMOTE",2)
+18 SET DA=IEN
SET DR=".01///"_NAME
+19 WRITE !,"Renaming LA7 Message Configuration "_$PIECE(^LAHM(62.48,IEN,0),U)_" to "_NAME
+20 DO ^DIE
+21 SET UPDT=1
End DoDot:1
+22 IF $GET(UPDT)=1
Begin DoDot:1
+23 NEW DIR,DIRUT
+24 WRITE !!,"For consistency and clarity the above Auto-Instrument names"
+25 WRITE !,"and Message Configurations have been changed from REMOTE to COLLECTION."
+26 SET DIR(0)="E"
DO ^DIR
End DoDot:1
+27 QUIT
+28 ;
+29 ;
GETLL(LA7X) ; Get Lower Level Protocol information for displaying
+1 ; Call with LA7X = ien of file #101 protocol
+2 ;
+3 ; Called from above and LA7VSET1
+4 ;
+5 NEW LA7Y
+6 ;
+7 DO GETS^DIQ(101,LA7X_",",".01;770.7","IE","LA7Y")
+8 ;
+9 WRITE !,?3,$GET(LA7Y(101,LA7X_",",.01,"E"))
+10 WRITE ?40,$GET(LA7Y(101,LA7X_",",770.7,"E"))
+11 IF $GET(LA7Y(101,LA7X_",",770.7,"I"))
WRITE " ("_$$GET1^DIQ(870,+LA7Y(101,LA7X_",",770.7,"I")_",",2)_")"
+12 ;
+13 QUIT
