HLP148 ;OIFO-O/RJH - HL*1.6*148 ENVIRONMENT AND POST-INSTALL ROUTINE ;09/29/2010
;;1.6;HEALTH LEVEL SEVEN;**148**;OCT 13, 1995;Build 3
;Per VHA Directive 2004-038, this routine should not be modified.
;
; check "TEXAS VALLEY COASTAL BEND HCS" entry in Institution file(#4),
; and "VALLEYCOASTALBEND.DOMAIN.EXT" entry in Domain file(#4.2)
;
N HLPARAM,HLSITE
;
S HLPARAM=$$PARAM^HLCS2
S HLSITE("DEFAULT-PROCESSING-ID")=$P(HLPARAM,"^",3)
;
I HLSITE("DEFAULT-PROCESSING-ID")="P" D
. D MES^XPDUTL("Checking environment ...")
. I '$O(^DIC(4,"D",740,0)) D
.. S XPDQUIT=2
.. D BMES^XPDUTL("'TEXAS VALLEY COASTAL BEND HCS' entry with station number as 740 ")
.. D MES^XPDUTL("does not exist in Institution file.")
. I '$O(^DIC(4.2,"B","VALLEYCOASTALBEND.DOMAIN.EXT",0)) D
.. S XPDQUIT=2
.. D BMES^XPDUTL("'VALLEYCOASTALBEND.DOMAIN.EXT' entry does not exist in Domain file,")
.. D MES^XPDUTL(" patch XM*999*173 must be installed first.")
. I $G(XPDQUIT) D BMES^XPDUTL("Aborting installation...")
Q
;
POST ; post install
;
D POST2
; D ENDPST
Q
;
POST2 ;
; deal with VAVCB entry in file #870.
; Is VAVCB entry in the HL LOGICAL LINK (#870) file?
; If yes, continue, If no, quit.
;
;find ien of VAVCB
N HLLINK
S HLLINK=$$VAVCB()
Q:'HLLINK
;
; check and update fields of VAVCB
D UPDATE
Q
;
VAVCB() ;
; for VAVCB entry
;
N HLLLK
S HLLLK=+$$FIND1^DIC(870,"","X","VAVCB")
;
; if no VAVCB entry, abort install
I HLLLK=0 D
. D BMES^XPDUTL(" 'VAVCB' logical link failed to come in with this patch.")
. D MES^XPDUTL(" Log a Remedy ticket for assistance before proceeding.")
. S XPDABORT=1
;
Q HLLLK
;
UPDATE ;
;update the following fields for logical link, VAVCB:
; - DNS Domain (#.08)
; - Autostart (#4.5)
; - Institution (#.02)
;
N HLDOM
N HLPARAM,HLSITE
N HLJ
N DIE,DR,X
;
S HLDOM="HL7.VALLEYCOASTALBEND.DOMAIN.EXT"
S HLPARAM=$$PARAM^HLCS2
S HLSITE("DEFAULT-PROCESSING-ID")=$P(HLPARAM,"^",3)
S HLSITE("INSTITUTION IEN")=$P(HLPARAM,"^",4)
S HLSITE("STATION NUMBER")=$P(^DIC(4,HLSITE("INSTITUTION IEN"),99),"^")
;
D BMES^XPDUTL(" Updating 'VAVCB' logical link ...")
F L +^HLCS(870,HLLINK):3 Q:$T H 1
; update AUTOSTART and DNS domain field if this is production
; account, MAILMAN DOMAIN fields should be updated by KIDS.
;
; update institution field
I (HLSITE("STATION NUMBER")'=740) D
. N DIE,DR,DA,X,VCBIEN,OTHER
. ; find ien of institution file (#4) with station number as 740
. S VCBIEN=$O(^DIC(4,"D",740,0))
. Q:'VCBIEN
. ; if the ien with station number as 740 is pointed to by
. ; other link, remove it.
. S OTHER=0
. F S OTHER=$O(^HLCS(870,"C",VCBIEN,OTHER)) Q:'OTHER D:(HLLINK'=OTHER)
. .N DIE,DR,DA,X
. .S DIE="^HLCS(870,",DA=OTHER,DR=".02///@"
. .D ^DIE
.S DIE="^HLCS(870,",DA=HLLINK,DR=".02///^S X=VCBIEN"
.D ^DIE
;
I HLSITE("DEFAULT-PROCESSING-ID")="P",(HLSITE("STATION NUMBER")'=740) D
.;
. S DIE="^HLCS(870,",DA=HLLINK,DR="4.5///1"
. ;
. I ($L($P(^HLCS(870,HLLINK,0),"^",8),".")'>2) D
.. ; the API FILE^DIE does not implement input transform
.. ; for updating TCP/IP ADDRESS field
.. S DR=DR_";.08///^S X=HLDOM"
. D ^DIE K DIE,DA,DR
;
; TEXAS VALLEY COASTAL BEND HCS site should have VAVCB entry as multi-listener.
I (HLSITE("STATION NUMBER")=740) D
. N IP
. ; remove data from AUTOSTART field
. S $P(^HLCS(870,HLLINK,0),"^",6)=""
. ; remove data from PERSISTENT field
. S $P(^HLCS(870,HLLINK,400),"^",4)=""
. ; remove data from EXCEED RE-TRANSMIT ACTION field
. S $P(^HLCS(870,HLLINK,200),"^",10)=""
. ; remove data from DNS DOMAIN field
. S $P(^HLCS(870,HLLINK,0),"^",8)=""
. K ^HLCS(870,"DNS","HL7.VALLEYCOASTALBEND.DOMAIN.EXT")
. K ^HLCS(870,"DNS2","HL7.VALLEYCOASTALBEND.DOMAIN.EXT")
. ; remove data from TCP/IP ADDRESS field
. S IP=$P(^HLCS(870,HLLINK,400),"^")
. I IP D
.. S $P(^HLCS(870,HLLINK,400),"^")=""
.. K ^HLCS(870,"IP",IP)
. ; check TCP/IP SERVICE TYPE
. I $P(^HLCS(870,HLLINK,400),"^",3)'="M" D
.. S $P(^HLCS(870,HLLINK,400),"^",3)="M"
.. K ^HLCS(870,"E","C",HLLINK)
.. S ^HLCS(870,"E","M",HLLINK)=""
. ;
. ; find ien of institution file (#4) with station number as 740
. N VCBIEN,OTHER
. S VCBIEN=$O(^DIC(4,"D",740,0))
. ; if the ien with station number as 740 is pointed to by
. ; other link, remove it.
. I VCBIEN S OTHER=$O(^HLCS(870,"C",VCBIEN,0))
. I VCBIEN,OTHER,(OTHER'=HLLINK) D
.. K ^HLCS(870,"C",VCBIEN)
.. S $P(^HLCS(870,OTHER,0),"^",2)=""
. ;
. ; update institution field
. I HLSITE("INSTITUTION IEN"),HLSITE("DEFAULT-PROCESSING-ID")="P" D
.. I '$D(^HLCS(870,"C",HLSITE("INSTITUTION IEN"),HLLINK)) D
... S ^HLCS(870,"C",HLSITE("INSTITUTION IEN"),HLLINK)=""
... S $P(^HLCS(870,HLLINK,0),"^",2)=HLSITE("INSTITUTION IEN")
. ;
. ; check TEST account of VALLEYCOASTALBEND
. I HLSITE("DEFAULT-PROCESSING-ID")'="P" D
.. I $P(^HLCS(870,HLLINK,400),"^",2)=5000 D
... S $P(^HLCS(870,HLLINK,400),"^",2)=5025
.. I $P(^HLCS(870,HLLINK,400),"^",8)=5001 D
... S $P(^HLCS(870,HLLINK,400),"^",8)=5026
;
L -^HLCS(870,HLLINK)
;
ENDPST2 ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLP148 5158 printed Dec 13, 2024@01:59:30 Page 2
HLP148 ;OIFO-O/RJH - HL*1.6*148 ENVIRONMENT AND POST-INSTALL ROUTINE ;09/29/2010
+1 ;;1.6;HEALTH LEVEL SEVEN;**148**;OCT 13, 1995;Build 3
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; check "TEXAS VALLEY COASTAL BEND HCS" entry in Institution file(#4),
+5 ; and "VALLEYCOASTALBEND.DOMAIN.EXT" entry in Domain file(#4.2)
+6 ;
+7 NEW HLPARAM,HLSITE
+8 ;
+9 SET HLPARAM=$$PARAM^HLCS2
+10 SET HLSITE("DEFAULT-PROCESSING-ID")=$PIECE(HLPARAM,"^",3)
+11 ;
+12 IF HLSITE("DEFAULT-PROCESSING-ID")="P"
Begin DoDot:1
+13 DO MES^XPDUTL("Checking environment ...")
+14 IF '$ORDER(^DIC(4,"D",740,0))
Begin DoDot:2
+15 SET XPDQUIT=2
+16 DO BMES^XPDUTL("'TEXAS VALLEY COASTAL BEND HCS' entry with station number as 740 ")
+17 DO MES^XPDUTL("does not exist in Institution file.")
End DoDot:2
+18 IF '$ORDER(^DIC(4.2,"B","VALLEYCOASTALBEND.DOMAIN.EXT",0))
Begin DoDot:2
+19 SET XPDQUIT=2
+20 DO BMES^XPDUTL("'VALLEYCOASTALBEND.DOMAIN.EXT' entry does not exist in Domain file,")
+21 DO MES^XPDUTL(" patch XM*999*173 must be installed first.")
End DoDot:2
+22 IF $GET(XPDQUIT)
DO BMES^XPDUTL("Aborting installation...")
End DoDot:1
+23 QUIT
+24 ;
POST ; post install
+1 ;
+2 DO POST2
+3 ; D ENDPST
+4 QUIT
+5 ;
POST2 ;
+1 ; deal with VAVCB entry in file #870.
+2 ; Is VAVCB entry in the HL LOGICAL LINK (#870) file?
+3 ; If yes, continue, If no, quit.
+4 ;
+5 ;find ien of VAVCB
+6 NEW HLLINK
+7 SET HLLINK=$$VAVCB()
+8 if 'HLLINK
QUIT
+9 ;
+10 ; check and update fields of VAVCB
+11 DO UPDATE
+12 QUIT
+13 ;
VAVCB() ;
+1 ; for VAVCB entry
+2 ;
+3 NEW HLLLK
+4 SET HLLLK=+$$FIND1^DIC(870,"","X","VAVCB")
+5 ;
+6 ; if no VAVCB entry, abort install
+7 IF HLLLK=0
Begin DoDot:1
+8 DO BMES^XPDUTL(" 'VAVCB' logical link failed to come in with this patch.")
+9 DO MES^XPDUTL(" Log a Remedy ticket for assistance before proceeding.")
+10 SET XPDABORT=1
End DoDot:1
+11 ;
+12 QUIT HLLLK
+13 ;
UPDATE ;
+1 ;update the following fields for logical link, VAVCB:
+2 ; - DNS Domain (#.08)
+3 ; - Autostart (#4.5)
+4 ; - Institution (#.02)
+5 ;
+6 NEW HLDOM
+7 NEW HLPARAM,HLSITE
+8 NEW HLJ
+9 NEW DIE,DR,X
+10 ;
+11 SET HLDOM="HL7.VALLEYCOASTALBEND.DOMAIN.EXT"
+12 SET HLPARAM=$$PARAM^HLCS2
+13 SET HLSITE("DEFAULT-PROCESSING-ID")=$PIECE(HLPARAM,"^",3)
+14 SET HLSITE("INSTITUTION IEN")=$PIECE(HLPARAM,"^",4)
+15 SET HLSITE("STATION NUMBER")=$PIECE(^DIC(4,HLSITE("INSTITUTION IEN"),99),"^")
+16 ;
+17 DO BMES^XPDUTL(" Updating 'VAVCB' logical link ...")
+18 FOR
LOCK +^HLCS(870,HLLINK):3
if $TEST
QUIT
HANG 1
+19 ; update AUTOSTART and DNS domain field if this is production
+20 ; account, MAILMAN DOMAIN fields should be updated by KIDS.
+21 ;
+22 ; update institution field
+23 IF (HLSITE("STATION NUMBER")'=740)
Begin DoDot:1
+24 NEW DIE,DR,DA,X,VCBIEN,OTHER
+25 ; find ien of institution file (#4) with station number as 740
+26 SET VCBIEN=$ORDER(^DIC(4,"D",740,0))
+27 if 'VCBIEN
QUIT
+28 ; if the ien with station number as 740 is pointed to by
+29 ; other link, remove it.
+30 SET OTHER=0
+31 FOR
SET OTHER=$ORDER(^HLCS(870,"C",VCBIEN,OTHER))
if 'OTHER
QUIT
if (HLLINK'=OTHER)
Begin DoDot:2
+32 NEW DIE,DR,DA,X
+33 SET DIE="^HLCS(870,"
SET DA=OTHER
SET DR=".02///@"
+34 DO ^DIE
End DoDot:2
+35 SET DIE="^HLCS(870,"
SET DA=HLLINK
SET DR=".02///^S X=VCBIEN"
+36 DO ^DIE
End DoDot:1
+37 ;
+38 IF HLSITE("DEFAULT-PROCESSING-ID")="P"
IF (HLSITE("STATION NUMBER")'=740)
Begin DoDot:1
+39 ;
+40 SET DIE="^HLCS(870,"
SET DA=HLLINK
SET DR="4.5///1"
+41 ;
+42 IF ($LENGTH($PIECE(^HLCS(870,HLLINK,0),"^",8),".")'>2)
Begin DoDot:2
+43 ; the API FILE^DIE does not implement input transform
+44 ; for updating TCP/IP ADDRESS field
+45 SET DR=DR_";.08///^S X=HLDOM"
End DoDot:2
+46 DO ^DIE
KILL DIE,DA,DR
End DoDot:1
+47 ;
+48 ; TEXAS VALLEY COASTAL BEND HCS site should have VAVCB entry as multi-listener.
+49 IF (HLSITE("STATION NUMBER")=740)
Begin DoDot:1
+50 NEW IP
+51 ; remove data from AUTOSTART field
+52 SET $PIECE(^HLCS(870,HLLINK,0),"^",6)=""
+53 ; remove data from PERSISTENT field
+54 SET $PIECE(^HLCS(870,HLLINK,400),"^",4)=""
+55 ; remove data from EXCEED RE-TRANSMIT ACTION field
+56 SET $PIECE(^HLCS(870,HLLINK,200),"^",10)=""
+57 ; remove data from DNS DOMAIN field
+58 SET $PIECE(^HLCS(870,HLLINK,0),"^",8)=""
+59 KILL ^HLCS(870,"DNS","HL7.VALLEYCOASTALBEND.DOMAIN.EXT")
+60 KILL ^HLCS(870,"DNS2","HL7.VALLEYCOASTALBEND.DOMAIN.EXT")
+61 ; remove data from TCP/IP ADDRESS field
+62 SET IP=$PIECE(^HLCS(870,HLLINK,400),"^")
+63 IF IP
Begin DoDot:2
+64 SET $PIECE(^HLCS(870,HLLINK,400),"^")=""
+65 KILL ^HLCS(870,"IP",IP)
End DoDot:2
+66 ; check TCP/IP SERVICE TYPE
+67 IF $PIECE(^HLCS(870,HLLINK,400),"^",3)'="M"
Begin DoDot:2
+68 SET $PIECE(^HLCS(870,HLLINK,400),"^",3)="M"
+69 KILL ^HLCS(870,"E","C",HLLINK)
+70 SET ^HLCS(870,"E","M",HLLINK)=""
End DoDot:2
+71 ;
+72 ; find ien of institution file (#4) with station number as 740
+73 NEW VCBIEN,OTHER
+74 SET VCBIEN=$ORDER(^DIC(4,"D",740,0))
+75 ; if the ien with station number as 740 is pointed to by
+76 ; other link, remove it.
+77 IF VCBIEN
SET OTHER=$ORDER(^HLCS(870,"C",VCBIEN,0))
+78 IF VCBIEN
IF OTHER
IF (OTHER'=HLLINK)
Begin DoDot:2
+79 KILL ^HLCS(870,"C",VCBIEN)
+80 SET $PIECE(^HLCS(870,OTHER,0),"^",2)=""
End DoDot:2
+81 ;
+82 ; update institution field
+83 IF HLSITE("INSTITUTION IEN")
IF HLSITE("DEFAULT-PROCESSING-ID")="P"
Begin DoDot:2
+84 IF '$DATA(^HLCS(870,"C",HLSITE("INSTITUTION IEN"),HLLINK))
Begin DoDot:3
+85 SET ^HLCS(870,"C",HLSITE("INSTITUTION IEN"),HLLINK)=""
+86 SET $PIECE(^HLCS(870,HLLINK,0),"^",2)=HLSITE("INSTITUTION IEN")
End DoDot:3
End DoDot:2
+87 ;
+88 ; check TEST account of VALLEYCOASTALBEND
+89 IF HLSITE("DEFAULT-PROCESSING-ID")'="P"
Begin DoDot:2
+90 IF $PIECE(^HLCS(870,HLLINK,400),"^",2)=5000
Begin DoDot:3
+91 SET $PIECE(^HLCS(870,HLLINK,400),"^",2)=5025
End DoDot:3
+92 IF $PIECE(^HLCS(870,HLLINK,400),"^",8)=5001
Begin DoDot:3
+93 SET $PIECE(^HLCS(870,HLLINK,400),"^",8)=5026
End DoDot:3
End DoDot:2
End DoDot:1
+94 ;
+95 LOCK -^HLCS(870,HLLINK)
+96 ;
ENDPST2 ;
