source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53P650.m@ 1804

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1DG53P650 ;ALB/KCL - PATCH DG*5.3*650 INSTALL UTILITIES ; 7/12/06 09:12am
2 ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
3 ;
4 QUIT
5 ;
6 ;--------------------------------------------------------------
7 ;Patch DG*5.3*650: Environment, Pre-Install, and Post-Install
8 ;entry points.
9 ;--------------------------------------------------------------
10 ;
11ENV ;Main entry point for Environment check point
12 ;
13 S XPDABORT=""
14 D PROGCHK(.XPDABORT) ;checks programmer variables
15 I XPDABORT="" K XPDABORT
16 Q
17 ;
18PRE ;Main entry point for Pre-Install items
19 ;
20 D PRE1 ;rename security key
21 D PRE2 ;delete obsolete security keys
22 Q
23 ;
24POST ;Main entry point for Post-Install items
25 ;
26 ;
27 D POST1 ;set query try limit parameter
28 D POST2 ;enable primary site for PRF Assignment ownership
29 D POST3 ;build "AOWN" index on file #26.13
30 Q
31 ;
32 ;
33PROGCHK(XPDABORT) ;Checks for necessary programmer variables
34 ;
35 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
36 .D BMES^XPDUTL("*****")
37 .D MES^XPDUTL("Your programming variables are not set up properly.")
38 .D MES^XPDUTL("Installation aborted.")
39 .D MES^XPDUTL("*****")
40 .S XPDABORT=2
41 Q
42 ;
43PRE1 ;Rename security keys
44 ;
45 N DGI,DGOLD,DGNEW
46 ;
47 S DGOLD(1)="DGPF RECORD FLAG ASSIGNMENT" ;old name
48 S DGNEW(1)="DGPF ASSIGNMENT" ;new name
49 ;
50 S DGOLD(2)="DGPF LOCAL FLAG EDIT" ;old name
51 S DGNEW(2)="DGPF MANAGER" ;new name
52 ;
53 D BMES^XPDUTL("*****")
54 D MES^XPDUTL("Attempting to rename security keys...")
55 ;
56 ;loop through keys
57 S DGI=0
58 F S DGI=$O(DGOLD(DGI)) Q:'DGI D ;drops out of DO block on failure
59 . ;
60 . ;quit if key already renamed
61 . I +$$LKUP^XPDKEY(DGNEW(DGI)) D Q
62 . . D MES^XPDUTL("Security key "_DGOLD(DGI)_" already renamed to "_DGNEW(DGI)_".")
63 . ;
64 . ;attempt to rename key
65 . I '$$RENAME^XPDKEY(DGOLD(DGI),DGNEW(DGI)) D Q
66 . . D MES^XPDUTL("Could not rename "_DGOLD(DGI)_" security key.")
67 . ;
68 . D MES^XPDUTL("Security key "_DGOLD(DGI)_" renamed to "_DGNEW(DGI)_".")
69 ;
70 D MES^XPDUTL("*****")
71 Q
72 ;
73PRE2 ;Delete obsolete security keys
74 ;
75 N DGIEN,DGNAME
76 ;
77 D BMES^XPDUTL("*****")
78 D MES^XPDUTL("Attempting to delete obsolete security keys...")
79 ;
80 ;loop thru obsolete keys
81 F DGNAME="DGPF PRF ACCESS","DGPF PRF CONFIG" D
82 . ;
83 . ;lookup key
84 . S DGIEN=$$LKUP^XPDKEY(DGNAME)
85 . ;
86 . ;quit with msg if key lookup fails
87 . I '+$G(DGIEN) D Q
88 . . D MES^XPDUTL("Security key "_DGNAME_" already deleted.")
89 . ;
90 . ;delete key
91 . D DEL^XPDKEY(+$G(DGIEN))
92 . D MES^XPDUTL("Security key "_DGNAME_" deleted. IEN="_DGIEN_".")
93 ;
94 D MES^XPDUTL("*****")
95 Q
96 ;
97POST1 ;set query try limit parameter
98 ;
99 N DGERR ;XPAR error result
100 N DGPARM ;parameter name
101 N DGRETRY ;# of retries
102 ;
103 S DGPARM="DGPF QUERY TRY LIMIT"
104 S DGRETRY=5
105 D EN^XPAR("PKG",DGPARM,1,DGRETRY,.DGERR)
106 D BMES^XPDUTL("*****")
107 I '$G(DGERR) D
108 . D MES^XPDUTL(DGPARM_" parameter set to "_DGRETRY_" SUCCESSFULLY")
109 E D
110 . D MES^XPDUTL(DGPARM_" parameter set FAILED")
111 D MES^XPDUTL("*****")
112 ;
113 Q
114 ;
115POST2 ;enable primary site for PRF Assignment ownership
116 ;
117 N DGDIV ;pointer to MEDICAL CENTER DIVISION (#40.8) file
118 N DGSITE ;$$SITE results
119 ;
120 S DGSITE=$$SITE^VASITE()
121 S DGDIV=+$O(^DG(40.8,"AD",+DGSITE,0))
122 D BMES^XPDUTL("*****")
123 I DGDIV,$$STODIV^DGPFDIV1(DGDIV,1) D
124 . D MES^XPDUTL($P(DGSITE,U,2)_" enabled for PRF Assignment ownership SUCCESSFULLY")
125 E D
126 . D MES^XPDUTL("Attempt to enable primary site for PRF Assignment ownership FAILED")
127 D MES^XPDUTL("*****")
128 ;
129 Q
130 ;
131POST3 ;populate "AOWN" index of PRF ASSIGNMENT (#26.13) file
132 ;
133 N DIK
134 ;
135 S DIK="^DGPF(26.13,"
136 S DIK(1)=".04^AOWN"
137 D ENALL^DIK
138 ;
139 Q
Note: See TracBrowser for help on using the repository browser.