| 1 | DG53P650 ;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 | ;
|
|---|
| 11 | ENV ;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 | ;
|
|---|
| 18 | PRE ;Main entry point for Pre-Install items
|
|---|
| 19 | ;
|
|---|
| 20 | D PRE1 ;rename security key
|
|---|
| 21 | D PRE2 ;delete obsolete security keys
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | POST ;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 | ;
|
|---|
| 33 | PROGCHK(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 | ;
|
|---|
| 43 | PRE1 ;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 | ;
|
|---|
| 73 | PRE2 ;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 | ;
|
|---|
| 97 | POST1 ;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 | ;
|
|---|
| 115 | POST2 ;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 | ;
|
|---|
| 131 | POST3 ;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
|
|---|
