LA7VSET.m

LA7VSET ;VA/DALOI/JMC - MENU TO SETUP VISN LABS ;JUL 06, 2010 3:14 PM

 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,55,46,64,1027**;NOV 01, 1997

 ;

 ; 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;2;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 test 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

LA7VSET   ;VA/DALOI/JMC - MENU TO SETUP VISN LABS ;JUL 06, 2010 3:14 PM

 +1       ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,55,46,64,1027**;NOV 01, 1997

 +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;2;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)=" "