159 lines
4.6 KiB
Mathematica
159 lines
4.6 KiB
Mathematica
LA7VLL ;DALOI\JMC - Setup HL7 v1.6 Logical Link for Consolidation ; 12/3/1997
|
|
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,55,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
|
|
;
|
|
MAIL(LRI) ;
|
|
;
|
|
Q:LRI=""
|
|
;
|
|
N DA,DIC,DIE,DLAYGO,DR,FDA,LA7DIE,LA7IENS,LA7LINK,LA7VMGP,LA7VX,LA7X,LA7Y,X
|
|
;
|
|
S LA7VMGP="LA7V "_$P(LRI,"^") D MAILGRP
|
|
;
|
|
W !!,"Updating HL LOGICAL LINK file (#870)."
|
|
S LA7X="LA7V"_$P(LRI,"^"),LA7Y=+$$FIND1^DIC(870,"","OX",LA7X)
|
|
I LA7Y S LA7LINK(LA7Y)=LA7X
|
|
; Check for old spelling using 'space' in name
|
|
I LA7Y<1 D
|
|
. S LA7Y=+$$FIND1^DIC(870,"","OX","LA7V "_$P(LRI,U))
|
|
. I LA7Y>0 S LA7LINK(LA7Y)=LA7X,FDA(1,870,LA7Y_",",.01)=LA7X
|
|
I LA7Y<1 D
|
|
. W !,?5,"Adding LA7V"_$P(LRI,"^")
|
|
. S X="LA7V"_$P(LRI,"^"),DIC="^HLCS(870,",DIC(0)="L",DLAYGO=870
|
|
. D ^DIC
|
|
. I Y>0 S LA7Y=+Y,LA7LINK(LA7Y)=$P(Y,U,2)
|
|
I LA7Y<1 D Q
|
|
. W !!,"Failure LA7V"_$P(LRI,"^")_" was not created in file #870."
|
|
S LA7IENS=LA7Y_","
|
|
S FDA(1,870,LA7IENS,2)="MAILMAN"
|
|
S FDA(1,870,LA7IENS,100.01)=LA7VMGP
|
|
D FILE^DIE("E","FDA(1)","LA7DIE(1)")
|
|
D CLEAN^DILF
|
|
D LL
|
|
;
|
|
Q
|
|
;
|
|
MAILGRP ; Create mail group for HL7 protocol logical link
|
|
;
|
|
N DA,DIC,DLAYGO,DOMAIN,LA738,LA7VDESC,LA7VXMY
|
|
;
|
|
W !!,"Creating mail group "_LA7VMGP_" for use by the"
|
|
W !,"HL7 v1.6 Logical Link "_LA7VMGP_"."
|
|
;
|
|
S LA7VXMY=""
|
|
S LA7VDESC(1)="This mail group is used by the HL7 Logical Link file for "
|
|
S LA7VDESC(2)="transmitting Lab data to site "_$P(LRI,"^",2)_"."
|
|
S LA738=$$MG^XMBGRP(LA7VMGP,0,DUZ,1,.LA7VXMY,.LA7VDESC,1)
|
|
I LA738<0 D Q
|
|
. W !!,"Failure: mail group ",LA7VMGP," was not created in file #3.8."
|
|
;
|
|
S DOMAIN=$$GET1^DIQ(4,+$P(LRI,"^",4)_",",60)
|
|
I $G(DOMAIN)="" D ERROR Q
|
|
;
|
|
; Add remote member to mail group
|
|
S DA(1)=LA738,DIC("P")=$P(^DD(3.8,12,0),U,2),DIC="^XMB(3.8,"_DA(1)_",6,",DIC(0)="L",DLAYGO=3.812
|
|
S X="S.HL V16 SERVER@"_DOMAIN
|
|
D ^DIC
|
|
Q
|
|
;
|
|
ERROR ; Error creating domain
|
|
;
|
|
W !!,"The INSTITUTION file (#4) entry for "_$P(LRI,"^",2)_" does not contain a domain."
|
|
W !,"Unable to create the COLLECTION system link for mail group ",$G(LA7VMGP),"."
|
|
W !,"The REMOTE MEMBER, S.HL V16 SERVER@domain name will need to be manually"
|
|
W !,"added to the mail group "_$G(LA7VMGP),"."
|
|
Q
|
|
;
|
|
;
|
|
TCP(LRI,PRIMARY) ;
|
|
;
|
|
N DIC,DA,DIE,DR,DLAYGO,FDA,LA7DIE,LA7IENS,LA7LINK,LA7P,LA7VX,LA7X,LA7Y,X
|
|
;
|
|
Q:LRI=""!PRIMARY=""
|
|
;
|
|
; Setup client logical link if one not associated with this institution
|
|
D LINK^HLUTIL3($P(LRI,"^",4),.LA7LINK,"")
|
|
I '$O(LA7LINK(0)) D
|
|
. W !!,"Updating HL LOGICAL LINK file (#870)."
|
|
. S LA7X="LA7V"_$P(LRI,U),LA7Y=+$$FIND1^DIC(870,"","OX",LA7X)
|
|
. I LA7Y>0 S LA7LINK(LA7Y)=LA7X
|
|
. ; Check for old spelling using 'space' in name
|
|
. I LA7Y<1 D
|
|
. . S LA7Y=+$$FIND1^DIC(870,"","OX","LA7V "_$P(LRI,U))
|
|
. . I LA7Y>0 S LA7LINK(LA7Y)=LA7X,FDA(1,870,LA7Y_",",.01)=LA7X
|
|
. I LA7Y<1 D
|
|
. . W !,?5,"Adding "_LA7X
|
|
. . S X=LA7X,DIC="^HLCS(870,",DIC(0)="L",DLAYGO=870
|
|
. . D ^DIC
|
|
. . I Y>0 S LA7Y=+Y,LA7LINK(LA7Y)=$P(Y,U,2)
|
|
. I LA7Y<1 D Q
|
|
. . W !!,"Failure "_LA7X_" was not created in file #870."
|
|
. S LA7IENS=LA7Y_","
|
|
. S FDA(1,870,LA7IENS,2)="TCP"
|
|
. S FDA(1,870,LA7IENS,100.01)="@"
|
|
. D FILE^DIE("E","FDA(1)","LA7DIE(1)")
|
|
. D CLEAN^DILF
|
|
;
|
|
; Setup server logical link if one not associated with this institution
|
|
D LINK^HLUTIL3($P(PRIMARY,"^"),.LA7P,"")
|
|
I '$O(LA7P(0)) D
|
|
. S LA7X="LA7V"_$P(PRIMARY,U,3),LA7Y=+$$FIND1^DIC(870,"","OX",LA7X)
|
|
. ; Check for old spelling using 'space' in name
|
|
. I LA7Y<1 D
|
|
. . S LA7Y=+$$FIND1^DIC(870,"","OX","LA7V "_$P(PRIMARY,U,3))
|
|
. . I LA7Y>0 S FDA(2,870,LA7Y_",",.01)=LA7X
|
|
. I LA7Y<1 D
|
|
. . W !,?5,"Adding "_LA7X
|
|
. . S X=LA7X,DIC="^HLCS(870,",DIC(0)="L",DLAYGO=870
|
|
. . D ^DIC
|
|
. . I Y>0 S LA7Y=+Y
|
|
. I LA7Y<1 D Q
|
|
. . W !!,"Failure "_LA7X_" was not created in file #870."
|
|
. K LA7IENS
|
|
. S LA7IENS=LA7Y_","
|
|
. S FDA(2,870,LA7IENS,2)="TCP"
|
|
. S FDA(2,870,LA7IENS,100.01)="@"
|
|
. D FILE^DIE("E","FDA(2)","LA7DIE(2)")
|
|
. D CLEAN^DILF
|
|
;
|
|
D LL
|
|
Q
|
|
;
|
|
;
|
|
LL ;
|
|
N DIR,DIRUT,DIROUT,DUOUT,DTOUT,LA7X,LINK,X
|
|
W !,"Updating the PROTOCOL file (#101)."
|
|
;
|
|
S X=$O(LA7LINK(0)),LINK=LA7LINK(X)
|
|
I $O(HOST(0)) D
|
|
. S LA7X="LA7V Process Results from "_$P(LRI,"^")
|
|
. D SETPRO(LA7X,"770.7///"_LINK)
|
|
. S LA7X="LA7V Send Order to "_$P(LRI,"^")
|
|
. D SETPRO(LA7X,"770.7///"_LINK)
|
|
;
|
|
I $O(REMOTE(0)) D
|
|
. S LA7X="LA7V Send Results to "_$P(LRI,"^")
|
|
. D SETPRO(LA7X,"770.7///"_LINK)
|
|
. S LA7X="LA7V Process Order from "_$P(LRI,"^")
|
|
. D SETPRO(LA7X,"770.7///"_LINK)
|
|
;
|
|
S DIR(0)="E" D ^DIR
|
|
Q
|
|
;
|
|
;
|
|
SETPRO(LA7X,LA7FLDS) ;
|
|
;
|
|
N DA,DIC,DIE,DLAYGO,DR,D0,X,Y
|
|
;
|
|
S X=$G(LA7X),DIC="^ORD(101,",DLAYGO=101,DIC(0)="LM"
|
|
D ^DIC
|
|
I +Y<1 Q
|
|
;
|
|
S DA=+Y,DR=LA7FLDS,DIE=DIC
|
|
D ^DIE
|
|
;
|
|
Q
|