LR382A ;HOIFO/JCH/LBC - Lab ADT Patch 382 Post Install routine ;April 06, 2011
;;5.2;LAB SERVICE;**382**;Sep 27, 1994;Build 188
;
; Reference to ^ORD(101,"B","VAFC ADT"* is supported by DBIA 4418
; Reference to ^HL(771 is supported by DBIA 10136
; Reference to ^HLCS(870 is supported by DBIA 1496
; Reference to ^DICN is supported by DBIA 10009
; Reference to ^DIE is supported by DBIA 10018
; Reference to ^DIK is supported by DBIA 10013
; Reference to ^DIR is supported by DBIA 10026
;
EN ; Check answers to post install questions
;LBC- no post install questions
; INPUT
; XPDQUES("POST INSTALL2") (conditional - required if XPDQUES("POST INSTALL1")="I"
; values: valid TCP/IP address. Format: nn.nn.nn.nn
;
; XPDQUES("POST INSTALL3") (conditional - required if XPDQUES("POST INSTALL1")="I"
; values: valid TCP/IP port. Format: 1-9 numeric.
;
; User selected to install (or reinstall) patch
;lbc;I $G(XPDQUES("POST INSTALL2"))!$G(XPDQUES("POST INSTALL3")) D ENI
;lbc;Q
;
ENI ; Patch 382 Post Install (Install)
N DR,DA,DIC,DIE,DD,DO,STOP,TCPAD,TCPORT
S STOP=0
;
S PROTNM="VBECS ADT" F S PROTNM=$O(^ORD(101,"B",PROTNM)) Q:($E(PROTNM,1,9))'="VBECS ADT"!$G(STOP) D
.Q:'(PROTNM["CLIENT")
.S EVENT=$P($P(PROTNM,"-",2)," "),TOPROTNM="VAFC ADT-"_EVENT_" SERVER"
.I $E(EVENT,2,3)>13 S STOP=1 Q
.I EVENT["A08" D Q
..N A8SUF F A8SUF=" SERVER","-SDAM SERVER","-TSP SERVER","-SCHED SERVER" S TOPROTNM="VAFC ADT-"_EVENT_A8SUF D ADD(PROTNM,TOPROTNM)
.D ADD(PROTNM,TOPROTNM)
;
; Unlink VBECS ADT-A08 ROUTER protocol from VAFC ADT-A08 SERVER protocol
S TOPROTNM="VAFC ADT-A08 SERVER"
S TOPROT=$O(^ORD(101,"B",TOPROTNM,"")) Q:'TOPROT
S NEXT=0 F S NEXT=$O(^ORD(101,TOPROT,775,NEXT)) Q:'NEXT D
.S PROT=$G(^ORD(101,TOPROT,775,NEXT,0)),PROTNM=$P($G(^ORD(101,PROT,0)),U)
.Q:'(PROTNM["VBECS ADT-A08 ROUTER")
.S DIK="^ORD(101,"_TOPROT_",775,",DA(1)=TOPROT,DA=NEXT D ^DIK K DIK,DA
;
Q
;
ADD(PROTNM,TOPROTNM) ; Add each PROTNM protocol as subscriber to TOPROTNM server protocol.
;
N PROT,TOPROT,DUP
S DUP=0
S TOPROT=$O(^ORD(101,"B",TOPROTNM,"")),PROT=$O(^ORD(101,"B",PROTNM,""))
N ND775,NXTSUB I $G(U)="" N U S U="^"
S ND775=$G(^ORD(101,TOPROT,775,0)),NXTSUB=$P(ND775,U,3)+1
S OTHSUBS=0 F S OTHSUBS=$O(^ORD(101,TOPROT,775,OTHSUBS)) Q:'OTHSUBS!$G(DUP) I ($G(^(OTHSUBS,0))=PROT) S DUP=1
; Don't add same protocol twice
Q:$G(DUP)
S DIC="^ORD(101,"_TOPROT_",775,",DIC("P")="101.0775PA",DINUM=NXTSUB,DA(1)=TOPROT,DIC(0)="L"
S DIC("DR")=".01////"_PROT,X=DINUM
D FILE^DICN K DR,DA,DIC
Q
;
ADDITEM(PROTNM,TOPROTNM) ; Add the PROTNM protocol as an ITEM to the TOPROTNM protocol
N PROT,TOPROT,DUP
S DUP=0
S TOPROT=$O(^ORD(101,"B",TOPROTNM,"")),PROT=$O(^ORD(101,"B",PROTNM,""))
N ND10,NXTITEM I $G(U)="" N U S U="^"
S ND10=$G(^ORD(101,TOPROT,10,0)),NXTITEM=$P(ND10,U,3)+1
S OTHITEMS=0 F S OTHITEMS=$O(^ORD(101,TOPROT,10,OTHITEMS)) Q:'OTHITEMS!$G(DUP) I ($G(^(OTHITEMS,0))=PROT) S DUP=1
; Don't add same item twice
Q:$G(DUP)
S DIC="^ORD(101,"_TOPROT_",10,",DIC("P")="101.01PA",DINUM=NXTITEM,DA(1)=TOPROT,DIC(0)="L"
S DIC("DR")=".01////"_PROT,X=DINUM
D FILE^DICN K DR,DA,DIC
Q
;
GETADD ; Prompt for TCP/IP Address
; Get TCP/IP Address for Logical Link, Port for Logical Link
N TCPADD,TCPORT,LINK,DIE,DIR
S DIR("A")="Enter TCP/IP Address of LRADT Logical Link"
S DIR(0)="F^7:16^K:X'?1.3N1"".""1.3N1"".""1.3N1"".""1.3N"
D ^DIR
I +$G(Y)>0 S TCPADD=Y
S DIR("A")="Enter TCP/IP Port of LRADT Logical Link"
S DIR(0)="N^1:99999999"
D ^DIR
I +$G(Y)>0 S TCPORT=Y
Q
;
SETCP(ADD,PORT) ; Set TCP address and port into logical link
Q:'ADD!'PORT
S LINK=+$O(^HLCS(870,"B","LRADT","")) Q:'LINK
S DIE="^HLCS(870,",DA=LINK,DR="400.01////"_ADD_";400.02////"_PORT
D ^DIE
Q
;
SETFAC ; Set Facility into HL7 Application Parameter
N FAC,APP
S FAC=0 S FAC=$O(^LRO(67.9,FAC)) Q:'FAC
S APP="" F APP="LRADT","LRADT TRIGGER" D
.S APPNUM=$O(^HL(771,"B",APP,""))
.N DIE,DA,DR
.S DIE="^HL(771,",DA=APPNUM,DR="3////"_FAC
.D ^DIE K DIE,DA,DR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR382A 4134 printed Dec 13, 2024@02:03:56 Page 2
LR382A ;HOIFO/JCH/LBC - Lab ADT Patch 382 Post Install routine ;April 06, 2011
+1 ;;5.2;LAB SERVICE;**382**;Sep 27, 1994;Build 188
+2 ;
+3 ; Reference to ^ORD(101,"B","VAFC ADT"* is supported by DBIA 4418
+4 ; Reference to ^HL(771 is supported by DBIA 10136
+5 ; Reference to ^HLCS(870 is supported by DBIA 1496
+6 ; Reference to ^DICN is supported by DBIA 10009
+7 ; Reference to ^DIE is supported by DBIA 10018
+8 ; Reference to ^DIK is supported by DBIA 10013
+9 ; Reference to ^DIR is supported by DBIA 10026
+10 ;
EN ; Check answers to post install questions
+1 ;LBC- no post install questions
+2 ; INPUT
+3 ; XPDQUES("POST INSTALL2") (conditional - required if XPDQUES("POST INSTALL1")="I"
+4 ; values: valid TCP/IP address. Format: nn.nn.nn.nn
+5 ;
+6 ; XPDQUES("POST INSTALL3") (conditional - required if XPDQUES("POST INSTALL1")="I"
+7 ; values: valid TCP/IP port. Format: 1-9 numeric.
+8 ;
+9 ; User selected to install (or reinstall) patch
+10 ;lbc;I $G(XPDQUES("POST INSTALL2"))!$G(XPDQUES("POST INSTALL3")) D ENI
+11 ;lbc;Q
+12 ;
ENI ; Patch 382 Post Install (Install)
+1 NEW DR,DA,DIC,DIE,DD,DO,STOP,TCPAD,TCPORT
+2 SET STOP=0
+3 ;
+4 SET PROTNM="VBECS ADT"
FOR
SET PROTNM=$ORDER(^ORD(101,"B",PROTNM))
if ($EXTRACT(PROTNM,1,9))'="VBECS ADT"!$GET(STOP)
QUIT
Begin DoDot:1
+5 if '(PROTNM["CLIENT")
QUIT
+6 SET EVENT=$PIECE($PIECE(PROTNM,"-",2)," ")
SET TOPROTNM="VAFC ADT-"_EVENT_" SERVER"
+7 IF $EXTRACT(EVENT,2,3)>13
SET STOP=1
QUIT
+8 IF EVENT["A08"
Begin DoDot:2
+9 NEW A8SUF
FOR A8SUF=" SERVER","-SDAM SERVER","-TSP SERVER","-SCHED SERVER"
SET TOPROTNM="VAFC ADT-"_EVENT_A8SUF
DO ADD(PROTNM,TOPROTNM)
End DoDot:2
QUIT
+10 DO ADD(PROTNM,TOPROTNM)
End DoDot:1
+11 ;
+12 ; Unlink VBECS ADT-A08 ROUTER protocol from VAFC ADT-A08 SERVER protocol
+13 SET TOPROTNM="VAFC ADT-A08 SERVER"
+14 SET TOPROT=$ORDER(^ORD(101,"B",TOPROTNM,""))
if 'TOPROT
QUIT
+15 SET NEXT=0
FOR
SET NEXT=$ORDER(^ORD(101,TOPROT,775,NEXT))
if 'NEXT
QUIT
Begin DoDot:1
+16 SET PROT=$GET(^ORD(101,TOPROT,775,NEXT,0))
SET PROTNM=$PIECE($GET(^ORD(101,PROT,0)),U)
+17 if '(PROTNM["VBECS ADT-A08 ROUTER")
QUIT
+18 SET DIK="^ORD(101,"_TOPROT_",775,"
SET DA(1)=TOPROT
SET DA=NEXT
DO ^DIK
KILL DIK,DA
End DoDot:1
+19 ;
+20 QUIT
+21 ;
ADD(PROTNM,TOPROTNM) ; Add each PROTNM protocol as subscriber to TOPROTNM server protocol.
+1 ;
+2 NEW PROT,TOPROT,DUP
+3 SET DUP=0
+4 SET TOPROT=$ORDER(^ORD(101,"B",TOPROTNM,""))
SET PROT=$ORDER(^ORD(101,"B",PROTNM,""))
+5 NEW ND775,NXTSUB
IF $GET(U)=""
NEW U
SET U="^"
+6 SET ND775=$GET(^ORD(101,TOPROT,775,0))
SET NXTSUB=$PIECE(ND775,U,3)+1
+7 SET OTHSUBS=0
FOR
SET OTHSUBS=$ORDER(^ORD(101,TOPROT,775,OTHSUBS))
if 'OTHSUBS!$GET(DUP)
QUIT
IF ($GET(^(OTHSUBS,0))=PROT)
SET DUP=1
+8 ; Don't add same protocol twice
+9 if $GET(DUP)
QUIT
+10 SET DIC="^ORD(101,"_TOPROT_",775,"
SET DIC("P")="101.0775PA"
SET DINUM=NXTSUB
SET DA(1)=TOPROT
SET DIC(0)="L"
+11 SET DIC("DR")=".01////"_PROT
SET X=DINUM
+12 DO FILE^DICN
KILL DR,DA,DIC
+13 QUIT
+14 ;
ADDITEM(PROTNM,TOPROTNM) ; Add the PROTNM protocol as an ITEM to the TOPROTNM protocol
+1 NEW PROT,TOPROT,DUP
+2 SET DUP=0
+3 SET TOPROT=$ORDER(^ORD(101,"B",TOPROTNM,""))
SET PROT=$ORDER(^ORD(101,"B",PROTNM,""))
+4 NEW ND10,NXTITEM
IF $GET(U)=""
NEW U
SET U="^"
+5 SET ND10=$GET(^ORD(101,TOPROT,10,0))
SET NXTITEM=$PIECE(ND10,U,3)+1
+6 SET OTHITEMS=0
FOR
SET OTHITEMS=$ORDER(^ORD(101,TOPROT,10,OTHITEMS))
if 'OTHITEMS!$GET(DUP)
QUIT
IF ($GET(^(OTHITEMS,0))=PROT)
SET DUP=1
+7 ; Don't add same item twice
+8 if $GET(DUP)
QUIT
+9 SET DIC="^ORD(101,"_TOPROT_",10,"
SET DIC("P")="101.01PA"
SET DINUM=NXTITEM
SET DA(1)=TOPROT
SET DIC(0)="L"
+10 SET DIC("DR")=".01////"_PROT
SET X=DINUM
+11 DO FILE^DICN
KILL DR,DA,DIC
+12 QUIT
+13 ;
GETADD ; Prompt for TCP/IP Address
+1 ; Get TCP/IP Address for Logical Link, Port for Logical Link
+2 NEW TCPADD,TCPORT,LINK,DIE,DIR
+3 SET DIR("A")="Enter TCP/IP Address of LRADT Logical Link"
+4 SET DIR(0)="F^7:16^K:X'?1.3N1"".""1.3N1"".""1.3N1"".""1.3N"
+5 DO ^DIR
+6 IF +$GET(Y)>0
SET TCPADD=Y
+7 SET DIR("A")="Enter TCP/IP Port of LRADT Logical Link"
+8 SET DIR(0)="N^1:99999999"
+9 DO ^DIR
+10 IF +$GET(Y)>0
SET TCPORT=Y
+11 QUIT
+12 ;
SETCP(ADD,PORT) ; Set TCP address and port into logical link
+1 if 'ADD!'PORT
QUIT
+2 SET LINK=+$ORDER(^HLCS(870,"B","LRADT",""))
if 'LINK
QUIT
+3 SET DIE="^HLCS(870,"
SET DA=LINK
SET DR="400.01////"_ADD_";400.02////"_PORT
+4 DO ^DIE
+5 QUIT
+6 ;
SETFAC ; Set Facility into HL7 Application Parameter
+1 NEW FAC,APP
+2 SET FAC=0
SET FAC=$ORDER(^LRO(67.9,FAC))
if 'FAC
QUIT
+3 SET APP=""
FOR APP="LRADT","LRADT TRIGGER"
Begin DoDot:1
+4 SET APPNUM=$ORDER(^HL(771,"B",APP,""))
+5 NEW DIE,DA,DR
+6 SET DIE="^HL(771,"
SET DA=APPNUM
SET DR="3////"_FAC
+7 DO ^DIE
KILL DIE,DA,DR
End DoDot:1
+8 QUIT
