| [613] | 1 | TIUPS225 ; ISL/JER - Post-install for TIU*1*225 ; 06/05/2007
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**225**;Jun 20, 1997;Build 13
|
|---|
| 3 | ;
|
|---|
| 4 | MAIN ; control subroutine
|
|---|
| 5 | D SETID
|
|---|
| 6 | D BALOINC
|
|---|
| 7 | D SETSEC
|
|---|
| 8 | D SETMGS
|
|---|
| 9 | Q
|
|---|
| 10 | SETID ; Create "Write identifier" for file 8925.1
|
|---|
| 11 | N TIUID
|
|---|
| 12 | D BMES^XPDUTL("SETTING ""WRITE"" IDENTIFIER ON FILE 8925.1")
|
|---|
| 13 | S TIUID="S %I=Y,Y=$S('$D(^(15)):"""",$D(^TIU(8926.1,+$P(^(15),U,1),0))#2:$P(^(0),U,1),1:"""") N DIERR S:Y]"""" Y=$$EXTERNAL^DILFD(8926.1,.01,"""",Y,""DIERR"") D:Y]"""" EN^DDIOL(Y,"""",""!?6,""""Std Title: """""") S Y=%I K %I"
|
|---|
| 14 | S ^DD(8925.1,0,"ID","W.1501")=TIUID
|
|---|
| 15 | Q
|
|---|
| 16 | BALOINC ; Build "ALOINC" x-ref on file 8925.1
|
|---|
| 17 | N DA,DIK,TIUCNT
|
|---|
| 18 | D BMES^XPDUTL("BUILDING NEW ""ALOINC"" CROSS-REFERENCE ON FILE 8925.1")
|
|---|
| 19 | ; remove "LOINC" cross-reference in preparation for building "ALOINC"
|
|---|
| 20 | K ^TIU(8925.1,"LOINC")
|
|---|
| 21 | S (DA,TIUCNT)=0,DIK="^TIU(8925.1,",DIK(1)="1501^ALOINC"
|
|---|
| 22 | F S DA=$O(^TIU(8925.1,DA)) Q:+DA'>0 D
|
|---|
| 23 | . D EN1^DIK
|
|---|
| 24 | . S TIUCNT=TIUCNT+1
|
|---|
| 25 | . I '(TIUCNT#10) D UPDATE^XPDID(TIUCNT)
|
|---|
| 26 | Q
|
|---|
| 27 | SETSEC ; set file security on 8926.1
|
|---|
| 28 | N TIUSC S TIUSC("RD")=""
|
|---|
| 29 | D FILESEC^DDMOD(8926.1,.TIUSC)
|
|---|
| 30 | Q
|
|---|
| 31 | SETMGS ; set mail groups for TIU ENTERPRISE STANDARD TITLES bulletin
|
|---|
| 32 | N TIUBIEN,TIUBNM,TIUERRF,TIUFDA,TIUGIEN,TIUGNM,TIULNE
|
|---|
| 33 | N TIUMSG,TIUTXT
|
|---|
| 34 | K TIUMSG
|
|---|
| 35 | D BMES^XPDUTL("Attaching Mail Groups to TIU ENTERPRISE STANDARD TITLES Bulletin")
|
|---|
| 36 | S TIUBNM="TIU ENTERPRISE STANDARD TITLES"
|
|---|
| 37 | S TIUBIEN=$$FIND1^DIC(3.6,"","X",TIUBNM,"","","")
|
|---|
| 38 | ;If Bulletin not found, error
|
|---|
| 39 | I TIUBIEN'>0 D I 1
|
|---|
| 40 | . S TIUMSG(1)="**"
|
|---|
| 41 | . S TIUMSG(2)="** Bulletin "_TIUBNM_" not found"
|
|---|
| 42 | . D MES^XPDUTL(.TIUMSG) K TIUMSG
|
|---|
| 43 | . S TIUERRF=1
|
|---|
| 44 | ELSE F TIUGNM="TIU CACS","XUMF SERVER" D Q:+$G(TIUERRF)
|
|---|
| 45 | . S TIUGIEN=$$FIND1^DIC(3.8,"","X",TIUGNM,"","","")
|
|---|
| 46 | . ;If Mail Group not found, error
|
|---|
| 47 | . I TIUGIEN'>0 D Q
|
|---|
| 48 | . . S TIUMSG(1)="**"
|
|---|
| 49 | . . S TIUMSG(2)="** Mail Group "_TIUGNM_" not found"
|
|---|
| 50 | . . D MES^XPDUTL(.TIUMSG) K TIUMSG
|
|---|
| 51 | . . S TIUERRF=1
|
|---|
| 52 | . ;Attach Mail Group to Bulletin
|
|---|
| 53 | . N TIUFDA,TIUIEN,TIUMSG
|
|---|
| 54 | . S TIUFDA(3.62,"?+2,"_TIUBIEN_",",.01)=TIUGIEN
|
|---|
| 55 | . D UPDATE^DIE("","TIUFDA","TIUIEN","TIUMSG")
|
|---|
| 56 | . ;Check for error
|
|---|
| 57 | . I $D(TIUMSG("DIERR")) D Q
|
|---|
| 58 | . . S TIUMSG(1)="**"
|
|---|
| 59 | . . S TIUMSG(2)="** Unable to attach "_TIUGNM_" to "_TIUBNM
|
|---|
| 60 | . . D MES^XPDUTL(.TIUMSG) K TIUMSG
|
|---|
| 61 | . . S TIUERRF=1
|
|---|
| 62 | . S TIUMSG(1)=" "
|
|---|
| 63 | . S TIUMSG(2)="... G."_TIUGNM_$S($G(TIUIEN(2,0))="?":" already",1:"")_" attached to "_TIUBNM_" Bulletin"
|
|---|
| 64 | . D MES^XPDUTL(.TIUMSG) K TIUMSG
|
|---|
| 65 | ;Check for error
|
|---|
| 66 | I $G(TIUERRF) D
|
|---|
| 67 | . S TIUMSG(1)="** Post-installation interrupted"
|
|---|
| 68 | . S TIUMSG(2)="** Please contact Enterprise VistA Support"
|
|---|
| 69 | . D MES^XPDUTL(.TIUMSG) K TIUMSG
|
|---|
| 70 | Q
|
|---|
