source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS225.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1TIUPS225 ; ISL/JER - Post-install for TIU*1*225 ; 06/05/2007
2 ;;1.0;TEXT INTEGRATION UTILITIES;**225**;Jun 20, 1997;Build 13
3 ;
4MAIN ; control subroutine
5 D SETID
6 D BALOINC
7 D SETSEC
8 D SETMGS
9 Q
10SETID ; 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
16BALOINC ; 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
27SETSEC ; set file security on 8926.1
28 N TIUSC S TIUSC("RD")=""
29 D FILESEC^DDMOD(8926.1,.TIUSC)
30 Q
31SETMGS ; 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
Note: See TracBrowser for help on using the repository browser.