| 1 | RORKIDS ;HCIOFO/SG - INSTALL UTILITIES (LOW-LEVEL) ; 4/21/05 2:02pm
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** DISPLAYS THE MESSAGE IF THE INSTALLATION ABORTS
|
|---|
| 7 | ABTMSG() ;
|
|---|
| 8 | ;;You can use the Print Log Files [RORMNT PRINT LOGS] option from
|
|---|
| 9 | ;;the Clinical Case Registries Maintenance [RORMNT MAIN] menu to
|
|---|
| 10 | ;;review the log file(s). The Install File Print [XPD PRINT INSTALL
|
|---|
| 11 | ;;FILE] option from the Utilities [XPD UTILITY] can help also.
|
|---|
| 12 | ;;Please fix the error(s) and restart the installation.
|
|---|
| 13 | ;;
|
|---|
| 14 | ;;NOTE: You must have the ROR VA IRM key to be able to access
|
|---|
| 15 | ;; the Clinical Case Registries files and view the logs.
|
|---|
| 16 | ;
|
|---|
| 17 | N I,INFO,MODE,TMP
|
|---|
| 18 | S MODE=+$G(RORPARM("KIDS"))
|
|---|
| 19 | S MODE=$S(MODE=1:"PRE-INSTALL",MODE=2:"POST-INSTALL",1:"")
|
|---|
| 20 | Q:MODE=""
|
|---|
| 21 | F I=1:1 S TMP=$T(ABTMSG+I) Q:TMP'[";;" S INFO(I)=$P(TMP,";;",2,99)
|
|---|
| 22 | D BMES("FATAL ERROR(S) DURING THE REGISTRY "_MODE_"!",.INFO)
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | ;***** SENDS AN ALERT
|
|---|
| 26 | ;
|
|---|
| 27 | ; DUZ DUZ of the addressee
|
|---|
| 28 | ;
|
|---|
| 29 | ; MSG Text of the message or negative error code. The '^'
|
|---|
| 30 | ; characters are replaced with spaces in the text.
|
|---|
| 31 | ;
|
|---|
| 32 | ; [REGNAME] Registry name
|
|---|
| 33 | ;
|
|---|
| 34 | ; [PATIEN] Patient IEN
|
|---|
| 35 | ;
|
|---|
| 36 | ; [ARG2-ARG5] Optional parameters as for $$ERROR^RORERR
|
|---|
| 37 | ;
|
|---|
| 38 | ALERT(DUZ,MSG,REGNAME,PATIEN,ARG2,ARG3,ARG4,ARG5) ;
|
|---|
| 39 | Q:'$G(DUZ)
|
|---|
| 40 | N XQA,XQADATA,XQAFLG,XQAMSG,XQAROU,TMP
|
|---|
| 41 | S XQA(DUZ)=""
|
|---|
| 42 | ;--- Get text of the error message
|
|---|
| 43 | I +MSG=MSG Q:MSG'<0 D
|
|---|
| 44 | . S MSG=$$MSG^RORERR20(+MSG,,.PATIEN,.ARG2,.ARG3,.ARG4,.ARG5)
|
|---|
| 45 | S MSG=$TR(MSG,"^","~"),XQAMSG="ROR: ",TMP=70-$L(XQAMSG)-3
|
|---|
| 46 | S XQAMSG=XQAMSG_$S($L(MSG)>TMP:$E(MSG,1,TMP)_"...",1:MSG)
|
|---|
| 47 | ;--- Setup alert processing routine
|
|---|
| 48 | S $P(XQADATA,U,1)=$E(MSG,1,78)
|
|---|
| 49 | S $P(XQADATA,U,2)=$G(REGNAME)
|
|---|
| 50 | S $P(XQADATA,U,3)=$G(PATIEN)
|
|---|
| 51 | S XQAROU="ALERTRTN^RORKIDS"
|
|---|
| 52 | ;--- Send the alert
|
|---|
| 53 | S XQAFLG="D" D SETUP^XQALERT
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | ;***** ALERT PROCESSING ROUTINE
|
|---|
| 57 | ;
|
|---|
| 58 | ; XQADATA Alert data
|
|---|
| 59 | ; ^1: Message
|
|---|
| 60 | ; ^2: Registry name
|
|---|
| 61 | ; ^3: Patient DFN
|
|---|
| 62 | ;
|
|---|
| 63 | ALERTRTN ;
|
|---|
| 64 | ;;Registry Name:
|
|---|
| 65 | ;;Patient DFN:
|
|---|
| 66 | ;
|
|---|
| 67 | Q:$G(XQADATA)=""
|
|---|
| 68 | N I,TMP
|
|---|
| 69 | W !!,$P(XQADATA,"^"),!
|
|---|
| 70 | F I=1:1:2 S TMP=$P(XQADATA,"^",I+1) D:TMP'=""
|
|---|
| 71 | . W $P($T(ALERTRTN+I),";;",2),?15,TMP,!
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | ;***** OUTPUTS THE MESSAGE AND PUTS IT INTO THE LOG
|
|---|
| 75 | BMES(MSG,INFO) ;
|
|---|
| 76 | N I
|
|---|
| 77 | D BMES^XPDUTL(" "_MSG)
|
|---|
| 78 | S I=""
|
|---|
| 79 | F S I=$O(INFO(I)) Q:I="" D MES^XPDUTL(" "_INFO(I))
|
|---|
| 80 | D LOG^RORLOG(,MSG,,.INFO)
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | ;***** CHECKS THE SCHEDULED OPTION
|
|---|
| 84 | ;
|
|---|
| 85 | ; OPTION Option name
|
|---|
| 86 | ;
|
|---|
| 87 | ; Return Values:
|
|---|
| 88 | ; <0 Error code
|
|---|
| 89 | ; 0 Ok
|
|---|
| 90 | ;
|
|---|
| 91 | ; This function can be used in the environment check routines to
|
|---|
| 92 | ; check if the option is running and/or scheduled to run.
|
|---|
| 93 | ;
|
|---|
| 94 | ; The function displays appropriate error messages and warnings
|
|---|
| 95 | ; using the WRITE command. So, it MUST NOT be called from the
|
|---|
| 96 | ; pre-install or post-install routines.
|
|---|
| 97 | ;
|
|---|
| 98 | ; The function uses the ^UTILITY($J,"W") node (^DIWP and ^DIWW).
|
|---|
| 99 | ;
|
|---|
| 100 | CHKOPT(OPTION) ;
|
|---|
| 101 | N DIWF,DIWL,DIWR,RC,RORBUF,RORI,RORSDT,TMP,X,ZTSK
|
|---|
| 102 | ;--- Check status of the option
|
|---|
| 103 | D OPTSTAT^XUTMOPT(OPTION,.RORBUF)
|
|---|
| 104 | S (RC,RORSDT)=0
|
|---|
| 105 | F RORI=1:1:$G(RORBUF) K ZTSK D I $G(ZTSK(1))=2 S RC=-76 Q
|
|---|
| 106 | . S ZTSK=$P(RORBUF(RORI),"^") Q:'ZTSK
|
|---|
| 107 | . D STAT^%ZTLOAD
|
|---|
| 108 | . S TMP=$P(RORBUF(RORI),"^",2)
|
|---|
| 109 | . I TMP>0 S:'RORSDT!(TMP<RORSDT) RORSDT=TMP
|
|---|
| 110 | ;--- Display an error message if the option is running
|
|---|
| 111 | I RC D Q RC
|
|---|
| 112 | . W !,$$MSG^RORERR20(RC,,,OPTION),!
|
|---|
| 113 | ;--- Display an apropriate warning
|
|---|
| 114 | S DIWL=5,DIWR=$G(IOM,80)-DIWL
|
|---|
| 115 | K ^UTILITY($J,"W")
|
|---|
| 116 | CM1 I RORSDT>0 D
|
|---|
| 117 | . ;;"The ["_OPTION_"] option is scheduled to run "_RORSDT_"."
|
|---|
| 118 | . ;;"If you are going to schedule the installation, please, choose"
|
|---|
| 119 | . ;;"an appropriate time so that the post-install will either"
|
|---|
| 120 | . ;;"finish well before the ["_OPTION_"] scheduled time or start"
|
|---|
| 121 | . ;;"after the option completion."
|
|---|
| 122 | . ;---
|
|---|
| 123 | . S RORSDT=$$FMTE^XLFDT(RORSDT)
|
|---|
| 124 | . S RORSDT="on "_$P(RORSDT,"@")_" at "_$P(RORSDT,"@",2)
|
|---|
| 125 | . F RORI=1:1 S X=$T(CM1+RORI) Q:X'[";;" D
|
|---|
| 126 | . . X "S X="_$P(X,";;",2) D ^DIWP
|
|---|
| 127 | CM2 E D
|
|---|
| 128 | . ;;"The ["_OPTION_"] option is not scheduled. Do not forget"
|
|---|
| 129 | . ;;"to schedule it after completion of the installation."
|
|---|
| 130 | . ;---
|
|---|
| 131 | . F RORI=1:1 S X=$T(CM2+RORI) Q:X'[";;" D
|
|---|
| 132 | . . X "S X="_$P(X,";;",2) D ^DIWP
|
|---|
| 133 | W ! D ^DIWW
|
|---|
| 134 | Q 0
|
|---|
| 135 | ;
|
|---|
| 136 | ;***** PROCESSES THE INSTALL CHECKPOINT
|
|---|
| 137 | ;
|
|---|
| 138 | ; CPNAME Checkpoint name
|
|---|
| 139 | ;
|
|---|
| 140 | ; CALLBACK Callback entry point ($$TAG^ROUTINE). This function
|
|---|
| 141 | ; accepts no parameters and must return either 0 if
|
|---|
| 142 | ; everything is Ok or a negative error code.
|
|---|
| 143 | ;
|
|---|
| 144 | ; [PARAM] Value to set checkpoint parameter to.
|
|---|
| 145 | ;
|
|---|
| 146 | ; The function checks if the checkpoint is completed. If it is not,
|
|---|
| 147 | ; the callback entry point is XECUTEd. If everything is Ok, the
|
|---|
| 148 | ; function will complete the checkpoint.
|
|---|
| 149 | ;
|
|---|
| 150 | ; Return Values:
|
|---|
| 151 | ; <0 Error code
|
|---|
| 152 | ; 0 Ok
|
|---|
| 153 | ;
|
|---|
| 154 | CP(CPNAME,CALLBACK,PARAM) ;
|
|---|
| 155 | N RC
|
|---|
| 156 | ;--- Verify the checkpoint and quit if it is completed
|
|---|
| 157 | S RC=$$VERCP^XPDUTL(CPNAME) Q:RC>0 0
|
|---|
| 158 | ;--- Create the new checkpoint
|
|---|
| 159 | I RC<0 D Q:'RC $$ERROR^RORERR(-50,,,,CPNAME)
|
|---|
| 160 | . S RC=$$NEWCP^XPDUTL(CPNAME,,.PARAM)
|
|---|
| 161 | ;--- Reset the KIDS progress bar
|
|---|
| 162 | S XPDIDTOT=0 D UPDATE^XPDID(0)
|
|---|
| 163 | ;--- Execute the callback entry point
|
|---|
| 164 | X "S RC="_CALLBACK Q:RC<0 RC
|
|---|
| 165 | ;--- Complete the check point
|
|---|
| 166 | S RC=$$COMCP^XPDUTL(CPNAME)
|
|---|
| 167 | Q:'RC $$ERROR^RORERR(-51,,,,CPNAME)
|
|---|
| 168 | Q 0
|
|---|
| 169 | ;
|
|---|
| 170 | ;***** DELETES THE (SUB)FILE DD AND DATA (IF REQUESTED)
|
|---|
| 171 | ;
|
|---|
| 172 | ; FILE File number
|
|---|
| 173 | ;
|
|---|
| 174 | ; [FLAGS] String that contains flags for EN^DIU2:
|
|---|
| 175 | ; "D" Delete the data as well as the DD
|
|---|
| 176 | ; "E" Echo back information during deletion
|
|---|
| 177 | ; "S" Subfile data dictionary is to be deleted
|
|---|
| 178 | ; "T" Templates are to be deleted
|
|---|
| 179 | ;
|
|---|
| 180 | ; [SILENT] If this parameters is defined and non-zero, the
|
|---|
| 181 | ; function will work in "silent" mode.
|
|---|
| 182 | ; Nothing (except error messages if debug mode >1 is
|
|---|
| 183 | ; enabled) will be displayed on the console or stored
|
|---|
| 184 | ; into the INSTALLATION file.
|
|---|
| 185 | ;
|
|---|
| 186 | ; Return Values:
|
|---|
| 187 | ; <0 Error code
|
|---|
| 188 | ; 0 Ok
|
|---|
| 189 | ;
|
|---|
| 190 | ; NOTE: This entry point can also be called as a procedure:
|
|---|
| 191 | ; D DELFILE^RORKIDS(...) if you do not need its return value.
|
|---|
| 192 | ;
|
|---|
| 193 | DELFILE(FILE,FLAGS,SILENT) ;
|
|---|
| 194 | I '$$VFILE^DILFD(+FILE) Q:$QUIT 0 Q
|
|---|
| 195 | N DIU,FT,RC
|
|---|
| 196 | S DIU=+FILE,DIU(0)=$G(FLAGS)
|
|---|
| 197 | I '$G(SILENT) D
|
|---|
| 198 | . S FT=$S(DIU(0)["S":"subfile",1:"file")
|
|---|
| 199 | . D BMES("Deleting the "_FT_" #"_(+FILE)_"...")
|
|---|
| 200 | D EN^DIU2
|
|---|
| 201 | D:'$G(SILENT) MES("The "_FT_" has been deleted.")
|
|---|
| 202 | Q:$QUIT 0 Q
|
|---|
| 203 | ;
|
|---|
| 204 | ;***** DELETES FIELD DEFENITIONS FROM THE DD
|
|---|
| 205 | ;
|
|---|
| 206 | ; FILE File number
|
|---|
| 207 | ;
|
|---|
| 208 | ; FLDLST String that contains list of field numbers to
|
|---|
| 209 | ; delete (separated with the ';').
|
|---|
| 210 | ;
|
|---|
| 211 | ; [SILENT] If this parameters is defined and non-zero, the
|
|---|
| 212 | ; function will work in "silent" mode.
|
|---|
| 213 | ; Nothing (except error messages if debug mode >1 is
|
|---|
| 214 | ; enabled) will be displayed on the console or stored
|
|---|
| 215 | ; into the INSTALLATION file.
|
|---|
| 216 | ;
|
|---|
| 217 | ; Return Values:
|
|---|
| 218 | ; <0 Error code
|
|---|
| 219 | ; 0 Ok
|
|---|
| 220 | ;
|
|---|
| 221 | ; NOTE: This entry point can also be called as a procedure:
|
|---|
| 222 | ; D DELFLDS^RORKIDS(...) if you do not need its return value.
|
|---|
| 223 | ;
|
|---|
| 224 | DELFLDS(FILE,FLDLST,SILENT) ;
|
|---|
| 225 | I '$$VFILE^DILFD(+FILE) Q:$QUIT 0 Q
|
|---|
| 226 | N DA,DIK,I,RC
|
|---|
| 227 | D:'$G(SILENT)
|
|---|
| 228 | . D BMES("Deleting the field definitions...")
|
|---|
| 229 | . D MES("File #"_(+FILE)_", Fields: '"_FLDLST_"'")
|
|---|
| 230 | S DA(1)=+FILE,DIK="^DD("_DA(1)_","
|
|---|
| 231 | F I=1:1 S DA=$P(FLDLST,";",I) Q:'DA D ^DIK
|
|---|
| 232 | D:'$G(SILENT) MES("The definitions have been deleted.")
|
|---|
| 233 | Q:$QUIT 0 Q
|
|---|
| 234 | ;
|
|---|
| 235 | ;***** OUTPUTS THE MESSAGE AND PUTS IT INTO THE LOG
|
|---|
| 236 | MES(MSG,INFO) ;
|
|---|
| 237 | N I
|
|---|
| 238 | D MES^XPDUTL(" "_MSG)
|
|---|
| 239 | S I=""
|
|---|
| 240 | F S I=$O(INFO(I)) Q:I="" D MES^XPDUTL(" "_INFO(I))
|
|---|
| 241 | D LOG^RORLOG(,MSG,,.INFO)
|
|---|
| 242 | Q
|
|---|
| 243 | ;
|
|---|
| 244 | ;***** RETURNS A VALUE OF THE INSTALLATION PARAMETER
|
|---|
| 245 | ;
|
|---|
| 246 | ; NAME Name of the parameter
|
|---|
| 247 | ;
|
|---|
| 248 | PARAM(NAME) ;
|
|---|
| 249 | Q $G(RORPARM("KIDS",NAME))
|
|---|
| 250 | ;
|
|---|
| 251 | ;***** UPDATES THE FILE'S PACKAGE REVISION DATA (IF NECESSARY)
|
|---|
| 252 | ;
|
|---|
| 253 | ; FILE File number
|
|---|
| 254 | ;
|
|---|
| 255 | ; [PRD] Package revision data
|
|---|
| 256 | ; ^01: Revision number (N.N)
|
|---|
| 257 | ; ^02: Patch name
|
|---|
| 258 | ;
|
|---|
| 259 | ; If this entry point is called as a function, it returns the
|
|---|
| 260 | ; previous value of the PACKAGE REVISION DATA attribute.
|
|---|
| 261 | ;
|
|---|
| 262 | PRD(FILE,PRD) ;
|
|---|
| 263 | N OLDPRD,RORMSG
|
|---|
| 264 | S OLDPRD=$$GET1^DID(FILE,,,"PACKAGE REVISION DATA",,"RORMSG")
|
|---|
| 265 | D:$G(PRD)>OLDPRD PRD^DILFD(FILE,PRD)
|
|---|
| 266 | Q:$QUIT OLDPRD Q
|
|---|
