Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAKIDS

RAKIDS.m

Go to the documentation of this file. 
  1. RAKIDS ;HCIOFO/SG - INSTALLATION UTILITIES ; 2/24/09 4:17pm
  1.  ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** DISPLAY THE ERROR MESSAGE WHEN INSTALLATION IS ABORTED
  1.  ;
  1.  ; [DLGNUM]      Dialog number (file #.84). Default: 700005.001
  1.  ;
  1. ABORTMSG(DLGNUM) ;
  1.  N PARAMS,RAI,RANODE,TMP
  1.  S:$G(DLGNUM)'>0 DLGNUM=700005.001
  1.  ;--- Load the message text
  1.  S TMP=+$G(RAPARAMS("KIDS"))
  1.  S PARAMS("KIDS")=$S(TMP=1:"pre-",TMP=2:"post-",1:"")_"install"
  1.  S RANODE=$$DLGTXT^RAUTL22(DLGNUM,.PARAMS,75)
  1.  ;--- Display the message
  1.  S RAI=""
  1.  F  S RAI=$O(@RANODE@(RAI))  Q:RAI=""  D MES(@RANODE@(RAI,0))
  1.  ;--- Cleanup
  1.  K @RANODE
  1.  Q
  1.  ;
  1.  ;***** OUTPUTS THE INSTALLATION MESSAGE WITH INDENTATION
  1.  ;
  1.  ; MSG           Message
  1.  ;
  1.  ; [.INFO]       Reference to a local array that contains additional
  1.  ;               text that will be displayed after the main message.
  1.  ;
  1.  ; This procedure automatically adds an empty string before the
  1.  ; message (see the BMES^XPDUTL).
  1.  ;
  1. BMES(MSG,INFO) ;
  1.  N I
  1.  D BMES^XPDUTL("   "_MSG)
  1.  S I=""
  1.  F  S I=$O(INFO(I))  Q:I=""  D MES^XPDUTL("   "_INFO(I))
  1.  Q
  1.  ;
  1.  ;***** PROCESSES THE INSTALL CHECKPOINT
  1.  ;
  1.  ; CPNAME        Checkpoint name
  1.  ;
  1.  ; CALLBACK      Callback entry point ($$TAG^ROUTINE). This function
  1.  ;               accepts no parameters and must return either 0 if
  1.  ;               everything is Ok or a negative error code.
  1.  ;
  1.  ; [PARAM]       Value to set checkpoint parameter to.
  1.  ;
  1.  ; The function checks if the checkpoint is completed. If it is not,
  1.  ; the callback entry point is XECUTEd. If everything is Ok, the
  1.  ; function completes the checkpoint and returns 0. Otherwise, an
  1.  ; error code is returned (it can be generated either by this function
  1.  ; itself or returned from the callback entry point).
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. CP(CPNAME,CALLBACK,PARAM) ;
  1.  N RC
  1.  ;--- Verify the checkpoint and quit if it is completed
  1.  S RC=$$VERCP^XPDUTL(CPNAME)  Q:RC>0 0
  1.  ;--- Create the new checkpoint
  1.  I RC<0  D  Q:'RC $$ERROR^RAERR(-46,,CPNAME)
  1.  . S RC=$$NEWCP^XPDUTL(CPNAME,,.PARAM)
  1.  ;--- Reset the KIDS progress bar
  1.  S XPDIDTOT=0  D UPDATE^XPDID(0)
  1.  ;--- Execute the callback entry point
  1.  X "S RC="_CALLBACK  Q:RC<0 RC
  1.  ;--- Complete the check point
  1.  S RC=$$COMCP^XPDUTL(CPNAME)
  1.  Q:'RC $$ERROR^RAERR(-47,,CPNAME)
  1.  Q 0
  1.  ;
  1.  ;***** DELETES THE (SUB)FILE DD AND DATA (IF REQUESTED)
  1.  ;
  1.  ; FILE          File or subfile number
  1.  ;
  1.  ; [FLAGS]       String that contains flags for EN^DIU2:
  1.  ;                 "D"  Delete the data as well as the DD
  1.  ;                 "E"  Echo back information during deletion
  1.  ;                 "S"  Subfile data dictionary is to be deleted
  1.  ;                 "T"  Templates are to be deleted
  1.  ;
  1.  ; [SILENT]      If this parameters is defined and non-zero, the
  1.  ;               function will work in "silent" mode.
  1.  ;               Nothing will be displayed on the console or stored
  1.  ;               into the INSTALLATION file.
  1.  ;
  1. DELFILE(FILE,FLAGS,SILENT) ;
  1.  Q:'$$VFILE^DILFD(+FILE)
  1.  N DIU,FT
  1.  S DIU=+FILE,DIU(0)=$G(FLAGS)
  1.  I '$G(SILENT)  D
  1.  . S FT=$S(DIU(0)["S":"subfile",1:"file")
  1.  . D BMES("Deleting the "_FT_" #"_(+FILE)_"...")
  1.  D EN^DIU2
  1.  D:'$G(SILENT) MES("The "_FT_" has been deleted.")
  1.  Q
  1.  ;
  1.  ;***** DELETES FIELD DEFENITIONS FROM THE DD
  1.  ;
  1.  ; FILE          File number
  1.  ;
  1.  ; FLDLST        String that contains list of field numbers to
  1.  ;               delete (separated with the ';').
  1.  ;
  1.  ; [SILENT]      If this parameters is defined and non-zero, the
  1.  ;               function will work in "silent" mode.
  1.  ;               Nothing will be displayed on the console or stored
  1.  ;               into the INSTALLATION file.
  1.  ;
  1. DELFLDS(FILE,FLDLST,SILENT) ;
  1.  Q:'$$VFILE^DILFD(+FILE)
  1.  N DA,DIK,I,RC
  1.  D:'$G(SILENT)
  1.  . D BMES("Deleting the field definitions...")
  1.  . D MES("File #"_(+FILE)_", Fields: '"_FLDLST_"'")
  1.  S DA(1)=+FILE,DIK="^DD("_DA(1)_","
  1.  F I=1:1  S DA=$P(FLDLST,";",I)  Q:'DA  D ^DIK
  1.  D:'$G(SILENT) MES("The definitions have been deleted.")
  1.  Q
  1.  ;
  1.  ;***** OUTPUTS THE INSTALLATION MESSAGE WITH INDENTATION
  1.  ;
  1.  ; MSG           Message
  1.  ;
  1.  ; [.INFO]       Reference to a local array that contains additional
  1.  ;               text that will be displayed after the main message.
  1.  ;
  1. MES(MSG,INFO) ;
  1.  N I
  1.  D MES^XPDUTL("   "_MSG)
  1.  S I=""
  1.  F  S I=$O(INFO(I))  Q:I=""  D MES^XPDUTL("   "_INFO(I))
  1.  Q
  1.  ;
  1.  ;***** UPDATES THE FILE'S PACKAGE REVISION DATA (IF NECESSARY)
  1.  ;
  1.  ; FILE          File number
  1.  ;
  1.  ; [PRD]         Package revision data
  1.  ;                 ^01: Revision number (N.N)
  1.  ;                 ^02: Patch name
  1.  ;
  1.  ; If this entry point is called as a function, it returns the
  1.  ; previous value of the PACKAGE REVISION DATA attribute.
  1.  ;
  1. PRD(FILE,PRD) ;
  1.  N OLDPRD,RORMSG
  1.  S OLDPRD=$$GET1^DID(FILE,,,"PACKAGE REVISION DATA",,"RORMSG")
  1.  D:$G(PRD)>OLDPRD PRD^DILFD(FILE,PRD)
  1.  Q:$QUIT OLDPRD  Q