MAGKIDS ;WOIFO/SG - INSTALLATION UTILITIES ; 3/9/09 12:52pm
;;3.0;IMAGING;**93**;Dec 02, 2009;Build 163
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
;***** DISPLAYS THE MESSAGE IF THE INSTALLATION ABORTS
ABTMSG() ;
;;Installation of the patch has been aborted due to error(s).
;;Please fix the problem(s) and restart the installation using
;;the Restart Install of Package(s) [XPD RESTART INSTALL] option
;;of the Installation ... [XPD INSTALLATION MENU] menu.
;
N I,TEXT,TMP
F I=2:1 S TMP=$T(ABTMSG+I) Q:TMP'[";;" S TEXT(I)=$P(TMP,";;",2,99)
D BMES($P($T(ABTMSG+1),";;",2,99),.TEXT)
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 MAGI
D BMES^XPDUTL(" "_MSG)
S MAGI=""
F S MAGI=$O(INFO(MAGI)) Q:MAGI="" D MES^XPDUTL(" "_INFO(MAGI))
Q
;
;##### PROCESSES THE INSTALL CHECKPOINT
;
; CPNAME Checkpoint name
;
; CALLBACK Callback entry point: "$$TAG^ROUTINE(PARAMETERS)".
; This function must return either 0 if everything is
; Ok or the error descriptor.
;
; [PARAM] Value to set the 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
;--- Validate parameters
I $G(CALLBACK)'?1"$$"1.8UN1"^MAG"1.5UN.1(1"(".E1")") D Q RC
. S RC=$$IPVE^MAGUERR("CALLBACK")
. Q
;--- 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^MAGUERR(-28,,CPNAME)
. S RC=$$NEWCP^XPDUTL(CPNAME,,.PARAM)
. Q
;--- 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^MAGUERR(-29,,CPNAME)
;--- Success
Q 0
;
;##### DELETES THE (SUB)FILE DD AND DATA (IF REQUESTED)
;
; FILE File or subfile number
;
; [DIU2FLAGS] Flags for the EN^DIU2 (can be combined):
;
; 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
;
; [FLAGS] Flags that control the execution (can be combined):
;
; S If this flag is provided, the procedure will
; work in "silent" mode. Nothing will be
; displayed on the console or stored into the
; INSTALLATION file (#9.7).
;
; Notes
; =====
;
; This entry point can be called either as a procedure or as a
; function (always returns 0).
;
DELFILE(FILE,DIU2FLAGS,FLAGS) ;
I '$$VFILE^DILFD(+FILE) Q:$QUIT 0 Q
N DIU,FT,RC
S FLAGS=$G(FLAGS)
S DIU=+FILE,DIU(0)=$G(DIU2FLAGS)
I FLAGS'["S" D
. S FT=$S(DIU(0)["S":"subfile",1:"file")
. D BMES("Deleting the "_FT_" #"_(+FILE)_"...")
. Q
D EN^DIU2
D:FLAGS'["S" MES("The "_FT_" has been deleted.")
Q:$QUIT 0 Q
;
;##### DELETES FIELD DEFINITIONS FROM THE DD
;
; FILE File number
;
; FLDLST String that contains list of field numbers to
; delete separated by semicolons.
;
; [FLAGS] Flags that control the execution (can be combined):
;
; S If this flag is provided, the procedure will
; work in "silent" mode. Nothing will be
; displayed on the console or stored into the
; INSTALLATION file (#9.7).
;
; Notes
; =====
;
; This entry point can be called either as a procedure or as a
; function (always returns 0).
;
DELFLDS(FILE,FLDLST,FLAGS) ;
I '$$VFILE^DILFD(+FILE) Q:$QUIT 0 Q
N DA,DIK,MAGI,RC
S FLAGS=$G(FLAGS)
D:FLAGS'["S"
. D BMES("Deleting the field definitions...")
. D MES("File #"_(+FILE)_", Fields: '"_FLDLST_"'")
. Q
S DA(1)=+FILE,DIK="^DD("_DA(1)_","
F MAGI=1:1 S DA=$P(FLDLST,";",MAGI) Q:'DA D ^DIK
D:FLAGS'["S" MES("The definitions have been deleted.")
Q:$QUIT 0 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 MAGI
D MES^XPDUTL(" "_MSG)
S MAGI=""
F S MAGI=$O(INFO(MAGI)) Q:MAGI="" D MES^XPDUTL(" "_INFO(MAGI))
Q
;
;##### CHECKS AND/OR UPDATES THE FILE'S PACKAGE REVISION DATA
;
; FILE File number
;
; PATCH Patch number (e.g. 93)
;
; [MODE] Execution mode:
;
; "A" Add the patch number to the file revision data
;
; "D" Delete the patch from the file revision data
;
; Return Values
; =============
; 0 Patch number is (was) in the file revision data
; 1 Patch number is (was) NOT in the revision data
;
; Notes
; =====
;
; If the MODE parameter is not defined or empty, then this function
; checks if the patch number is present in the file revision data.
;
; Otherwise, it performs the requested action and returns the value
; that indicates whether the patch number was present in the file
; revision data before the action.
;
; This entry point can also be called as a procedure:
; D PRD^MAGKIDS(...) if you do not need its return value.
;
; If a full data dictionary is exported in the KIDS build, the file
; revision data is also exported!
;
; When a new version of the package is released, package revison
; data for all package files must be cleared (use the PRD^DILFD).
;
PRD(FILE,PATCH,MODE) ;
N FOUND,MAGMSG,PRD
S PATCH=+PATCH
;
;=== Get the patch list from the file revision data
S PRD=$$GET1^DID(FILE,,,"PACKAGE REVISION DATA",,"MAGMSG")
S PRD=$TR(PRD," "),FOUND=(","_PRD_",")[(","_PATCH_",")
;
;=== Add the patch number to the list
I $G(MODE)="A" D:'FOUND Q:$QUIT FOUND Q
. N I
. S I=$L(PRD,",") S:$P(PRD,",",I)'="" I=I+1
. S $P(PRD,",",I)=PATCH
. ;--- If the list is too long, purge the oldest entries
. F Q:$L(PRD)<254 S $P(PRD,",",1,2)=$P(PRD,",",2)
. ;--- Store the list as the file revision data
. D PRD^DILFD(FILE,PRD)
. Q
;
;=== Delete the patch number from the list
I $G(MODE)="D" D:FOUND Q:$QUIT FOUND Q
. N I,IP
. F I=$L(PRD,","):-1:1 I $P(PRD,",",I)=PATCH S IP=I Q
. Q:$G(IP)'>0 ; This should never happen.
. S $P(PRD,",",IP,IP+1)=$P(PRD,",",IP+1)
. ;--- Remove the trailing comma
. S I=$L(PRD) S:$E(PRD,I)="," $E(PRD,I)=""
. ;--- Store the list as the file revision data
. D PRD^DILFD(FILE,PRD)
. Q
;
;===
Q:$QUIT FOUND Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGKIDS 8450 printed Oct 16, 2024@18:07:47 Page 2
MAGKIDS ;WOIFO/SG - INSTALLATION UTILITIES ; 3/9/09 12:52pm
+1 ;;3.0;IMAGING;**93**;Dec 02, 2009;Build 163
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | |
+11 ;; | The Food and Drug Administration classifies this software as |
+12 ;; | a medical device. As such, it may not be changed in any way. |
+13 ;; | Modifications to this software may result in an adulterated |
+14 ;; | medical device under 21CFR820, the use of which is considered |
+15 ;; | to be a violation of US Federal Statutes. |
+16 ;; +---------------------------------------------------------------+
+17 ;;
+18 QUIT
+19 ;
+20 ;***** DISPLAYS THE MESSAGE IF THE INSTALLATION ABORTS
ABTMSG() ;
+1 ;;Installation of the patch has been aborted due to error(s).
+2 ;;Please fix the problem(s) and restart the installation using
+3 ;;the Restart Install of Package(s) [XPD RESTART INSTALL] option
+4 ;;of the Installation ... [XPD INSTALLATION MENU] menu.
+5 ;
+6 NEW I,TEXT,TMP
+7 FOR I=2:1
SET TMP=$TEXT(ABTMSG+I)
if TMP'[";;"
QUIT
SET TEXT(I)=$PIECE(TMP,";;",2,99)
+8 DO BMES($PIECE($TEXT(ABTMSG+1),";;",2,99),.TEXT)
+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 ;
+18 ; This procedure automatically adds an empty string before the
+19 ; message (see the BMES^XPDUTL).
+20 ;
BMES(MSG,INFO) ;
+1 NEW MAGI
+2 DO BMES^XPDUTL(" "_MSG)
+3 SET MAGI=""
+4 FOR
SET MAGI=$ORDER(INFO(MAGI))
if MAGI=""
QUIT
DO MES^XPDUTL(" "_INFO(MAGI))
+5 QUIT
+6 ;
+7 ;##### PROCESSES THE INSTALL CHECKPOINT
+8 ;
+9 ; CPNAME Checkpoint name
+10 ;
+11 ; CALLBACK Callback entry point: "$$TAG^ROUTINE(PARAMETERS)".
+12 ; This function must return either 0 if everything is
+13 ; Ok or the error descriptor.
+14 ;
+15 ; [PARAM] Value to set the 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 ; =============
+25 ; <0 Error code
+26 ; 0 Ok
+27 ;
CP(CPNAME,CALLBACK,PARAM) ;
+1 NEW RC
+2 ;--- Validate parameters
+3 IF $GET(CALLBACK)'?1"$$"1.8UN1"^MAG"1.5UN.1(1"(".E1")")
Begin DoDot:1
+4 SET RC=$$IPVE^MAGUERR("CALLBACK")
+5 QUIT
End DoDot:1
QUIT RC
+6 ;--- Verify the checkpoint and quit if it is completed
+7 SET RC=$$VERCP^XPDUTL(CPNAME)
if RC>0
QUIT 0
+8 ;--- Create the new checkpoint
+9 IF RC<0
Begin DoDot:1
+10 SET RC=$$NEWCP^XPDUTL(CPNAME,,.PARAM)
+11 QUIT
End DoDot:1
if 'RC
QUIT $$ERROR^MAGUERR(-28,,CPNAME)
+12 ;--- Reset the KIDS progress bar
+13 SET XPDIDTOT=0
DO UPDATE^XPDID(0)
+14 ;--- Execute the callback entry point
+15 XECUTE "S RC="_CALLBACK
if RC<0
QUIT RC
+16 ;--- Complete the check point
+17 SET RC=$$COMCP^XPDUTL(CPNAME)
+18 if 'RC
QUIT $$ERROR^MAGUERR(-29,,CPNAME)
+19 ;--- Success
+20 QUIT 0
+21 ;
+22 ;##### DELETES THE (SUB)FILE DD AND DATA (IF REQUESTED)
+23 ;
+24 ; FILE File or subfile number
+25 ;
+26 ; [DIU2FLAGS] Flags for the EN^DIU2 (can be combined):
+27 ;
+28 ; D Delete the data as well as the DD
+29 ; E Echo back information during deletion
+30 ; S Subfile data dictionary is to be deleted
+31 ; T Templates are to be deleted
+32 ;
+33 ; [FLAGS] Flags that control the execution (can be combined):
+34 ;
+35 ; S If this flag is provided, the procedure will
+36 ; work in "silent" mode. Nothing will be
+37 ; displayed on the console or stored into the
+38 ; INSTALLATION file (#9.7).
+39 ;
+40 ; Notes
+41 ; =====
+42 ;
+43 ; This entry point can be called either as a procedure or as a
+44 ; function (always returns 0).
+45 ;
DELFILE(FILE,DIU2FLAGS,FLAGS) ;
+1 IF '$$VFILE^DILFD(+FILE)
if $QUIT
QUIT 0
QUIT
+2 NEW DIU,FT,RC
+3 SET FLAGS=$GET(FLAGS)
+4 SET DIU=+FILE
SET DIU(0)=$GET(DIU2FLAGS)
+5 IF FLAGS'["S"
Begin DoDot:1
+6 SET FT=$SELECT(DIU(0)["S":"subfile",1:"file")
+7 DO BMES("Deleting the "_FT_" #"_(+FILE)_"...")
+8 QUIT
End DoDot:1
+9 DO EN^DIU2
+10 if FLAGS'["S"
DO MES("The "_FT_" has been deleted.")
+11 if $QUIT
QUIT 0
QUIT
+12 ;
+13 ;##### DELETES FIELD DEFINITIONS FROM THE DD
+14 ;
+15 ; FILE File number
+16 ;
+17 ; FLDLST String that contains list of field numbers to
+18 ; delete separated by semicolons.
+19 ;
+20 ; [FLAGS] Flags that control the execution (can be combined):
+21 ;
+22 ; S If this flag is provided, the procedure will
+23 ; work in "silent" mode. Nothing will be
+24 ; displayed on the console or stored into the
+25 ; INSTALLATION file (#9.7).
+26 ;
+27 ; Notes
+28 ; =====
+29 ;
+30 ; This entry point can be called either as a procedure or as a
+31 ; function (always returns 0).
+32 ;
DELFLDS(FILE,FLDLST,FLAGS) ;
+1 IF '$$VFILE^DILFD(+FILE)
if $QUIT
QUIT 0
QUIT
+2 NEW DA,DIK,MAGI,RC
+3 SET FLAGS=$GET(FLAGS)
+4 if FLAGS'["S"
Begin DoDot:1
+5 DO BMES("Deleting the field definitions...")
+6 DO MES("File #"_(+FILE)_", Fields: '"_FLDLST_"'")
+7 QUIT
End DoDot:1
+8 SET DA(1)=+FILE
SET DIK="^DD("_DA(1)_","
+9 FOR MAGI=1:1
SET DA=$PIECE(FLDLST,";",MAGI)
if 'DA
QUIT
DO ^DIK
+10 if FLAGS'["S"
DO MES("The definitions have been deleted.")
+11 if $QUIT
QUIT 0
QUIT
+12 ;
+13 ;##### OUTPUTS THE INSTALLATION MESSAGE WITH INDENTATION
+14 ;
+15 ; MSG Message
+16 ;
+17 ; [.INFO] Reference to a local array that contains additional
+18 ; text that will be displayed after the main message.
+19 ;
MES(MSG,INFO) ;
+1 NEW MAGI
+2 DO MES^XPDUTL(" "_MSG)
+3 SET MAGI=""
+4 FOR
SET MAGI=$ORDER(INFO(MAGI))
if MAGI=""
QUIT
DO MES^XPDUTL(" "_INFO(MAGI))
+5 QUIT
+6 ;
+7 ;##### CHECKS AND/OR UPDATES THE FILE'S PACKAGE REVISION DATA
+8 ;
+9 ; FILE File number
+10 ;
+11 ; PATCH Patch number (e.g. 93)
+12 ;
+13 ; [MODE] Execution mode:
+14 ;
+15 ; "A" Add the patch number to the file revision data
+16 ;
+17 ; "D" Delete the patch from the file revision data
+18 ;
+19 ; Return Values
+20 ; =============
+21 ; 0 Patch number is (was) in the file revision data
+22 ; 1 Patch number is (was) NOT in the revision data
+23 ;
+24 ; Notes
+25 ; =====
+26 ;
+27 ; If the MODE parameter is not defined or empty, then this function
+28 ; checks if the patch number is present in the file revision data.
+29 ;
+30 ; Otherwise, it performs the requested action and returns the value
+31 ; that indicates whether the patch number was present in the file
+32 ; revision data before the action.
+33 ;
+34 ; This entry point can also be called as a procedure:
+35 ; D PRD^MAGKIDS(...) if you do not need its return value.
+36 ;
+37 ; If a full data dictionary is exported in the KIDS build, the file
+38 ; revision data is also exported!
+39 ;
+40 ; When a new version of the package is released, package revison
+41 ; data for all package files must be cleared (use the PRD^DILFD).
+42 ;
PRD(FILE,PATCH,MODE) ;
+1 NEW FOUND,MAGMSG,PRD
+2 SET PATCH=+PATCH
+3 ;
+4 ;=== Get the patch list from the file revision data
+5 SET PRD=$$GET1^DID(FILE,,,"PACKAGE REVISION DATA",,"MAGMSG")
+6 SET PRD=$TRANSLATE(PRD," ")
SET FOUND=(","_PRD_",")[(","_PATCH_",")
+7 ;
+8 ;=== Add the patch number to the list
+9 IF $GET(MODE)="A"
if 'FOUND
Begin DoDot:1
+10 NEW I
+11 SET I=$LENGTH(PRD,",")
if $PIECE(PRD,",",I)'=""
SET I=I+1
+12 SET $PIECE(PRD,",",I)=PATCH
+13 ;--- If the list is too long, purge the oldest entries
+14 FOR
if $LENGTH(PRD)<254
QUIT
SET $PIECE(PRD,",",1,2)=$PIECE(PRD,",",2)
+15 ;--- Store the list as the file revision data
+16 DO PRD^DILFD(FILE,PRD)
+17 QUIT
End DoDot:1
if $QUIT
QUIT FOUND
QUIT
+18 ;
+19 ;=== Delete the patch number from the list
+20 IF $GET(MODE)="D"
if FOUND
Begin DoDot:1
+21 NEW I,IP
+22 FOR I=$LENGTH(PRD,","):-1:1
IF $PIECE(PRD,",",I)=PATCH
SET IP=I
QUIT
+23 ; This should never happen.
if $GET(IP)'>0
QUIT
+24 SET $PIECE(PRD,",",IP,IP+1)=$PIECE(PRD,",",IP+1)
+25 ;--- Remove the trailing comma
+26 SET I=$LENGTH(PRD)
if $EXTRACT(PRD,I)=","
SET $EXTRACT(PRD,I)=""
+27 ;--- Store the list as the file revision data
+28 DO PRD^DILFD(FILE,PRD)
+29 QUIT
End DoDot:1
if $QUIT
QUIT FOUND
QUIT
+30 ;
+31 ;===
+32 if $QUIT
QUIT FOUND
QUIT
