Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7VSET1

LA7VSET1.m

Go to the documentation of this file. 
  1. LA7VSET1 ;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
  1.  ;
  1.  ; Reference to HL LOGICAL LINK file (#870) supported by DBIA #1495, 1496, 2063
  1.  ; Reference to PROTOCOL file (#101) supported by DBIA #872
  1.  ; Reference to MAIL GROUP file (#3.8) supported by DBIA #2061
  1.  ;
  1. COLLECT ; Collection Lab Setup Menu
  1.  ;
  1.  N LA7CNT,LA7,LA7P,LA7A,REMOTE
  1.  ;
  1.  ;
  1.  F  D  Q:'LA7A
  1.  . S REMOTE="COLLECTION Lab(s)"
  1.  . D RMTBLD,RMTHDR,RMTLST,KDIR
  1.  . W !! S DIR(0)="NO^1:"_LA7CNT
  1.  . D R1HLP
  1.  . D ^DIR
  1.  . I $D(DIRUT) S LA7A=0 Q
  1.  . S LA7A=Y D AEREMT
  1.  Q
  1.  ;
  1.  ;
  1. RMTBLD ; Identify all COLLECTION labs using LA7 MESSAGE PARAMETER file (#62.48)
  1.  ;
  1.  N LA7,LA74,SNAME,SNUM
  1.  S LA7CNT=1,(LA7,LA7P)="LA7V COLLECTION "
  1.  F  S LA7=$O(^LAHM(62.48,"B",LA7)) Q:LA7=""!(LA7'[LA7P)  D
  1.  . S SNUM=$P(LA7,"COLLECTION ",2)
  1.  . S LA74=$$FINDSITE^LA7VHLU2(SNUM,2,1) Q:LA74'>0
  1.  . S SNAME=$P($$NS^XUAF4(LA74),"^")
  1.  . S REMOTE(LA7CNT)=SNUM_U_SNAME_U_LA7_U_LA74,LA7CNT=LA7CNT+1
  1.  S REMOTE(LA7CNT)=""
  1.  Q
  1.  ;
  1.  ;
  1. RMTHDR ; Collection setup header
  1.  ;
  1.  W @IOF,! F X=1:1:79 W "-"
  1.  W !,?((80-$L(REMOTE))/2),REMOTE
  1.  W ! F X=1:1:79 W "-"
  1.  W !!
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. RMTLST ;
  1.  S LA7CNT=1,LA7=0
  1.  F  S LA7=$O(REMOTE(LA7)) Q:'LA7  D
  1.  . I REMOTE(LA7)="" Q
  1.  . W !,LA7,".",?5,$P(REMOTE(LA7),U,2)_"  ("_$P(REMOTE(LA7),U,3)_")"
  1.  . S LA7CNT=LA7CNT+1
  1.  ;
  1.  W !,LA7CNT,".",?5,"Add COLLECTION Lab"
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. RMTHDR2 ;
  1.  N LA7624,LA76248,LA7870,LA7X
  1.  ;
  1.  S LA7CNT=1
  1.  W !!,"1. COLLECTION Lab: ",?15,$P(REMOTE(LA7A),U,2)
  1.  W:$P(REMOTE(LA7A),U,2)'="" "  (Uneditable)"
  1.  ;
  1.  I $P(REMOTE(LA7A),U,2)="" Q
  1.  ;
  1.  D LINK^HLUTIL3($P(REMOTE(LA7A),"^",4),.LA7X,"")
  1.  S LA7870=+$O(LA7X(0))
  1.  I 'LA7870 D
  1.  . S LA7870=+$$FIND1^DIC(870,"","OX","LA7V"_$P(REMOTE(LA7A),U))
  1.  . I 'LA7870 S LA7870=+$$FIND1^DIC(870,"","OX","LA7V "_$P(REMOTE(LA7A),U))
  1.  . I LA7870 S LA7X(LA7870)=$$GET1^DIQ(870,LA7870_",",.01)
  1.  S LA7CNT=2
  1.  W !,"2. Logical Link (TCP/IP): ",$G(LA7X(LA7870))
  1.  ;
  1.  S LA76248=$$FIND1^DIC(62.48,"","OX","LA7V COLLECTION "_$P(REMOTE(LA7A),U)),LA7CNT=3
  1.  W !,"3. Message Configuration: ",$$GET1^DIQ(62.48,LA76248_",",.01)
  1.  Q
  1.  ;
  1.  ;
  1. AEREMT ;
  1.  ;
  1.  N CHA
  1.  ;
  1.  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
  1.  . I CHA=1 D RLAB($P(REMOTE(LA7A),U))
  1.  . I CHA=2 D RLL
  1.  . I CHA=3 D LMC
  1.  Q
  1.  ;
  1.  ;
  1. LMC ; Edit Lab message configuration file
  1.  ;
  1.  N DIC,DA,DR,DIE,LA76248
  1.  ;
  1.  S LA76248=$$FIND1^DIC(62.48,"","OX","LA7V COLLECTION "_$P(REMOTE(LA7A),U))
  1.  I LA76248<0 W !,"You have not entered a "_LAB_" lab." Q
  1.  S DA=LA76248,DIE="^LAHM(62.48,",DR="3;4;10;@20;20;I X'="""" S Y=""@20"""
  1.  D ^DIE
  1.  Q
  1.  ;
  1.  ;
  1. RLAB(LRI) ;Add REMOTE LAB
  1.  ;
  1.  N INST,LA7VER
  1.  ;
  1.  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
  1.  ;
  1.  I $P(REMOTE(LA7A),U)="" D
  1.  . N DIC,DA,DO
  1.  . S DIC="^DIC(4,",DIC(0)="AEMQZ"
  1.  . 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"")"
  1.  . D ^DIC Q:Y<1
  1.  . S INST=+Y
  1.  . I PRIMARY=INST!(INST=DUZ(2)) D  Q
  1.  . . W !,"To add your Hospital as a COLLECTION site just add HOST sites."
  1.  . S REMOTE(LA7A+1)=REMOTE(LA7A)
  1.  . S REMOTE(LA7A)=$$RETFACID^LA7VHLU2(INST,2,1)_U_$P($$NS^XUAF4(INST),"^")_"^^"_INST
  1.  ;
  1.  I $P(REMOTE(LA7A),U)="" S $P(REMOTE(LA7A),U,2)="" Q
  1.  ;
  1.  I PRIMARY'=$P(REMOTE(LA7A),U) D
  1.  . S LA7VER=2.3
  1.  . I $$NVAF^LA7VHLU2($P(REMOTE(LA7A),"^",4))=1 S LA7VER=2.2
  1.  . D REMOTE^LA7VSTP(PRIMARY,PRSITE,$P(REMOTE(LA7A),U),$P(REMOTE(LA7A),U,2),LA7VER)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;
  1. RLL ; add/edit logical link
  1.  ;
  1.  N HDR,PR,LA7LL
  1.  ;
  1.  S HDR="Logical Link for transmissions to/from "_$P(REMOTE(LA7A),U,2)
  1.  W @IOF,! F X=1:1:79 W "-"
  1.  W !,?((80-$L(HDR))/2),HDR
  1.  W ! F X=1:1:79 W "-"
  1.  W !,?3,"Protocol",?40,"Logical Link",!,?3,"----------",?40,"---------------",!!
  1.  ;
  1.  S PR=$O(^ORD(101,"B","LA7V Process Order from "_$P(REMOTE(LA7A),U),0))
  1.  I PR D GETLL^LA7VSET(PR)
  1.  ;
  1.  S PR=$O(^ORD(101,"B","LA7V Send Results to "_$P(REMOTE(LA7A),U),0))
  1.  I PR D GETLL^LA7VSET(PR)
  1.  ;
  1.  W !!
  1.  D KDIR
  1.  S DIR("A")="Setup/update Logical Link",DIR(0)="YO"
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  I Y=1 D TCP^LA7VLL(REMOTE(LA7A),LA7VS)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. R1HLP ; HOST Lab(s) help
  1.  S DIR("?")="Enter a number between 1 and "_LA7CNT_"."
  1.  S DIR("?",1)="Enter a '"_LA7CNT_"' to create a new COLLECTION lab."
  1.  Q
  1.  ;
  1.  ;
  1. R2HLP ; HOST Lab Setup help
  1.  S DIR("?")="Enter a number between 1 and "_LA7CNT_".  For new entries begin with '1.  HOST Lab:'"
  1.  S DIR("?",1)="Enter a '1' to create the HL7 environment along with the Auto-Instrument"
  1.  S DIR("?",2)="and LA7 Message Configuration."
  1.  S DIR("?",3)="Enter a '2' to create the link between the COLLECTION and HOST labs."
  1.  S DIR("?",4)="Enter a '3' to configure the LA7 MESSAGE PARAMETER file."
  1.  Q
  1.  ;
  1. KDIR ;
  1.  K DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1.  Q