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