- LA7VLL ;VA/DALOI/JMC - Setup HL7 v1.6 Logical Link for Consolidation ;JUL 06, 2010 3:14 PM
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,55,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
- ;
- 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
- LA7VLL ;VA/DALOI/JMC - Setup HL7 v1.6 Logical Link for Consolidation ;JUL 06, 2010 3:14 PM
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,55,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 ;
- MAIL(LRI) ;
- +1 ;
- +2 IF LRI=""
- QUIT
- +3 ;
- +4 NEW DA,DIC,DIE,DLAYGO,DR,FDA,LA7DIE,LA7IENS,LA7LINK,LA7VMGP,LA7VX,LA7X,LA7Y,X
- +5 ;
- +6 SET LA7VMGP="LA7V "_$PIECE(LRI,"^")
- DO MAILGRP
- +7 ;
- +8 WRITE !!,"Updating HL LOGICAL LINK file (#870)."
- +9 SET LA7X="LA7V"_$PIECE(LRI,"^")
- SET LA7Y=+$$FIND1^DIC(870,"","OX",LA7X)
- +10 IF LA7Y
- SET LA7LINK(LA7Y)=LA7X
- +11 ; Check for old spelling using 'space' in name
- +12 IF LA7Y<1
- Begin DoDot:1
- +13 SET LA7Y=+$$FIND1^DIC(870,"","OX","LA7V "_$PIECE(LRI,U))
- +14 IF LA7Y>0
- SET LA7LINK(LA7Y)=LA7X
- SET FDA(1,870,LA7Y_",",.01)=LA7X
- End DoDot:1
- +15 IF LA7Y<1
- Begin DoDot:1
- +16 WRITE !,?5,"Adding LA7V"_$PIECE(LRI,"^")
- +17 SET X="LA7V"_$PIECE(LRI,"^")
- SET DIC="^HLCS(870,"
- SET DIC(0)="L"
- SET DLAYGO=870
- +18 DO ^DIC
- +19 IF Y>0
- SET LA7Y=+Y
- SET LA7LINK(LA7Y)=$PIECE(Y,U,2)
- End DoDot:1
- +20 IF LA7Y<1
- Begin DoDot:1
- +21 WRITE !!,"Failure LA7V"_$PIECE(LRI,"^")_" was not created in file #870."
- End DoDot:1
- QUIT
- +22 SET LA7IENS=LA7Y_","
- +23 SET FDA(1,870,LA7IENS,2)="MAILMAN"
- +24 SET FDA(1,870,LA7IENS,100.01)=LA7VMGP
- +25 DO FILE^DIE("E","FDA(1)","LA7DIE(1)")
- +26 DO CLEAN^DILF
- +27 DO LL
- +28 ;
- +29 QUIT
- +30 ;
- MAILGRP ; Create mail group for HL7 protocol logical link
- +1 ;
- +2 NEW DA,DIC,DLAYGO,DOMAIN,LA738,LA7VDESC,LA7VXMY
- +3 ;
- +4 WRITE !!,"Creating mail group "_LA7VMGP_" for use by the"
- +5 WRITE !,"HL7 v1.6 Logical Link "_LA7VMGP_"."
- +6 ;
- +7 SET LA7VXMY=""
- +8 SET LA7VDESC(1)="This mail group is used by the HL7 Logical Link file for "
- +9 SET LA7VDESC(2)="transmitting Lab data to site "_$PIECE(LRI,"^",2)_"."
- +10 SET LA738=$$MG^XMBGRP(LA7VMGP,0,DUZ,1,.LA7VXMY,.LA7VDESC,1)
- +11 IF LA738<0
- Begin DoDot:1
- +12 WRITE !!,"Failure: mail group ",LA7VMGP," was not created in file #3.8."
- End DoDot:1
- QUIT
- +13 ;
- +14 SET DOMAIN=$$GET1^DIQ(4,+$PIECE(LRI,"^",4)_",",60)
- +15 IF $GET(DOMAIN)=""
- DO ERROR
- QUIT
- +16 ;
- +17 ; Add remote member to mail group
- +18 SET DA(1)=LA738
- SET DIC("P")=$PIECE(^DD(3.8,12,0),U,2)
- SET DIC="^XMB(3.8,"_DA(1)_",6,"
- SET DIC(0)="L"
- SET DLAYGO=3.812
- +19 SET X="S.HL V16 SERVER@"_DOMAIN
- +20 DO ^DIC
- +21 QUIT
- +22 ;
- ERROR ; Error creating domain
- +1 ;
- +2 WRITE !!,"The INSTITUTION file (#4) entry for "_$PIECE(LRI,"^",2)_" does not contain a domain."
- +3 WRITE !,"Unable to create the COLLECTION system link for mail group ",$GET(LA7VMGP),"."
- +4 WRITE !,"The REMOTE MEMBER, S.HL V16 SERVER@domain name will need to be manually"
- +5 WRITE !,"added to the mail group "_$GET(LA7VMGP),"."
- +6 QUIT
- +7 ;
- +8 ;
- TCP(LRI,PRIMARY) ;
- +1 ;
- +2 NEW DIC,DA,DIE,DR,DLAYGO,FDA,LA7DIE,LA7IENS,LA7LINK,LA7P,LA7VX,LA7X,LA7Y,X
- +3 ;
- +4 IF LRI=""!PRIMARY=""
- QUIT
- +5 ;
- +6 ; Setup client logical link if one not associated with this institution
- +7 DO LINK^HLUTIL3($PIECE(LRI,"^",4),.LA7LINK,"")
- +8 IF '$ORDER(LA7LINK(0))
- Begin DoDot:1
- +9 WRITE !!,"Updating HL LOGICAL LINK file (#870)."
- +10 SET LA7X="LA7V"_$PIECE(LRI,U)
- SET LA7Y=+$$FIND1^DIC(870,"","OX",LA7X)
- +11 IF LA7Y>0
- SET LA7LINK(LA7Y)=LA7X
- +12 ; Check for old spelling using 'space' in name
- +13 IF LA7Y<1
- Begin DoDot:2
- +14 SET LA7Y=+$$FIND1^DIC(870,"","OX","LA7V "_$PIECE(LRI,U))
- +15 IF LA7Y>0
- SET LA7LINK(LA7Y)=LA7X
- SET FDA(1,870,LA7Y_",",.01)=LA7X
- End DoDot:2
- +16 IF LA7Y<1
- Begin DoDot:2
- +17 WRITE !,?5,"Adding "_LA7X
- +18 SET X=LA7X
- SET DIC="^HLCS(870,"
- SET DIC(0)="L"
- SET DLAYGO=870
- +19 DO ^DIC
- +20 IF Y>0
- SET LA7Y=+Y
- SET LA7LINK(LA7Y)=$PIECE(Y,U,2)
- End DoDot:2
- +21 IF LA7Y<1
- Begin DoDot:2
- +22 WRITE !!,"Failure "_LA7X_" was not created in file #870."
- End DoDot:2
- QUIT
- +23 SET LA7IENS=LA7Y_","
- +24 SET FDA(1,870,LA7IENS,2)="TCP"
- +25 SET FDA(1,870,LA7IENS,100.01)="@"
- +26 DO FILE^DIE("E","FDA(1)","LA7DIE(1)")
- +27 DO CLEAN^DILF
- End DoDot:1
- +28 ;
- +29 ; Setup server logical link if one not associated with this institution
- +30 DO LINK^HLUTIL3($PIECE(PRIMARY,"^"),.LA7P,"")
- +31 IF '$ORDER(LA7P(0))
- Begin DoDot:1
- +32 SET LA7X="LA7V"_$PIECE(PRIMARY,U,3)
- SET LA7Y=+$$FIND1^DIC(870,"","OX",LA7X)
- +33 ; Check for old spelling using 'space' in name
- +34 IF LA7Y<1
- Begin DoDot:2
- +35 SET LA7Y=+$$FIND1^DIC(870,"","OX","LA7V "_$PIECE(PRIMARY,U,3))
- +36 IF LA7Y>0
- SET FDA(2,870,LA7Y_",",.01)=LA7X
- End DoDot:2
- +37 IF LA7Y<1
- Begin DoDot:2
- +38 WRITE !,?5,"Adding "_LA7X
- +39 SET X=LA7X
- SET DIC="^HLCS(870,"
- SET DIC(0)="L"
- SET DLAYGO=870
- +40 DO ^DIC
- +41 IF Y>0
- SET LA7Y=+Y
- End DoDot:2
- +42 IF LA7Y<1
- Begin DoDot:2
- +43 WRITE !!,"Failure "_LA7X_" was not created in file #870."
- End DoDot:2
- QUIT
- +44 KILL LA7IENS
- +45 SET LA7IENS=LA7Y_","
- +46 SET FDA(2,870,LA7IENS,2)="TCP"
- +47 SET FDA(2,870,LA7IENS,100.01)="@"
- +48 DO FILE^DIE("E","FDA(2)","LA7DIE(2)")
- +49 DO CLEAN^DILF
- End DoDot:1
- +50 ;
- +51 DO LL
- +52 QUIT
- +53 ;
- +54 ;
- LL ;
- +1 NEW DIR,DIRUT,DIROUT,DUOUT,DTOUT,LA7X,LINK,X
- +2 WRITE !,"Updating the PROTOCOL file (#101)."
- +3 ;
- +4 SET X=$ORDER(LA7LINK(0))
- SET LINK=LA7LINK(X)
- +5 IF $ORDER(HOST(0))
- Begin DoDot:1
- +6 SET LA7X="LA7V Process Results from "_$PIECE(LRI,"^")
- +7 DO SETPRO(LA7X,"770.7///"_LINK)
- +8 SET LA7X="LA7V Send Order to "_$PIECE(LRI,"^")
- +9 DO SETPRO(LA7X,"770.7///"_LINK)
- End DoDot:1
- +10 ;
- +11 IF $ORDER(REMOTE(0))
- Begin DoDot:1
- +12 SET LA7X="LA7V Send Results to "_$PIECE(LRI,"^")
- +13 DO SETPRO(LA7X,"770.7///"_LINK)
- +14 SET LA7X="LA7V Process Order from "_$PIECE(LRI,"^")
- +15 DO SETPRO(LA7X,"770.7///"_LINK)
- End DoDot:1
- +16 ;
- +17 SET DIR(0)="E"
- DO ^DIR
- +18 QUIT
- +19 ;
- +20 ;
- SETPRO(LA7X,LA7FLDS) ;
- +1 ;
- +2 NEW DA,DIC,DIE,DLAYGO,DR,D0,X,Y
- +3 ;
- +4 SET X=$GET(LA7X)
- SET DIC="^ORD(101,"
- SET DLAYGO=101
- SET DIC(0)="LM"
- +5 DO ^DIC
- +6 IF +Y<1
- QUIT
- +7 ;
- +8 SET DA=+Y
- SET DR=LA7FLDS
- SET DIE=DIC
- +9 DO ^DIE
- +10 ;
- +11 QUIT