RORKIDS ;HCIOFO/SG - INSTALL UTILITIES (LOW-LEVEL) ; 4/21/05 2:02pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** DISPLAYS THE MESSAGE IF THE INSTALLATION ABORTS
ABTMSG() ;
;;You can use the Print Log Files [RORMNT PRINT LOGS] option from
;;the Clinical Case Registries Maintenance [RORMNT MAIN] menu to
;;review the log file(s). The Install File Print [XPD PRINT INSTALL
;;FILE] option from the Utilities [XPD UTILITY] can help also.
;;Please fix the error(s) and restart the installation.
;;
;;NOTE: You must have the ROR VA IRM key to be able to access
;; the Clinical Case Registries files and view the logs.
;
N I,INFO,MODE,TMP
S MODE=+$G(RORPARM("KIDS"))
S MODE=$S(MODE=1:"PRE-INSTALL",MODE=2:"POST-INSTALL",1:"")
Q:MODE=""
F I=1:1 S TMP=$T(ABTMSG+I) Q:TMP'[";;" S INFO(I)=$P(TMP,";;",2,99)
D BMES("FATAL ERROR(S) DURING THE REGISTRY "_MODE_"!",.INFO)
Q
;
;***** SENDS AN ALERT
;
; DUZ DUZ of the addressee
;
; MSG Text of the message or negative error code. The '^'
; characters are replaced with spaces in the text.
;
; [REGNAME] Registry name
;
; [PATIEN] Patient IEN
;
; [ARG2-ARG5] Optional parameters as for $$ERROR^RORERR
;
ALERT(DUZ,MSG,REGNAME,PATIEN,ARG2,ARG3,ARG4,ARG5) ;
Q:'$G(DUZ)
N XQA,XQADATA,XQAFLG,XQAMSG,XQAROU,TMP
S XQA(DUZ)=""
;--- Get text of the error message
I +MSG=MSG Q:MSG'<0 D
. S MSG=$$MSG^RORERR20(+MSG,,.PATIEN,.ARG2,.ARG3,.ARG4,.ARG5)
S MSG=$TR(MSG,"^","~"),XQAMSG="ROR: ",TMP=70-$L(XQAMSG)-3
S XQAMSG=XQAMSG_$S($L(MSG)>TMP:$E(MSG,1,TMP)_"...",1:MSG)
;--- Setup alert processing routine
S $P(XQADATA,U,1)=$E(MSG,1,78)
S $P(XQADATA,U,2)=$G(REGNAME)
S $P(XQADATA,U,3)=$G(PATIEN)
S XQAROU="ALERTRTN^RORKIDS"
;--- Send the alert
S XQAFLG="D" D SETUP^XQALERT
Q
;
;***** ALERT PROCESSING ROUTINE
;
; XQADATA Alert data
; ^1: Message
; ^2: Registry name
; ^3: Patient DFN
;
ALERTRTN ;
;;Registry Name:
;;Patient DFN:
;
Q:$G(XQADATA)=""
N I,TMP
W !!,$P(XQADATA,"^"),!
F I=1:1:2 S TMP=$P(XQADATA,"^",I+1) D:TMP'=""
. W $P($T(ALERTRTN+I),";;",2),?15,TMP,!
Q
;
;***** OUTPUTS THE MESSAGE AND PUTS IT INTO THE LOG
BMES(MSG,INFO) ;
N I
D BMES^XPDUTL(" "_MSG)
S I=""
F S I=$O(INFO(I)) Q:I="" D MES^XPDUTL(" "_INFO(I))
D LOG^RORLOG(,MSG,,.INFO)
Q
;
;***** CHECKS THE SCHEDULED OPTION
;
; OPTION Option name
;
; Return Values:
; <0 Error code
; 0 Ok
;
; This function can be used in the environment check routines to
; check if the option is running and/or scheduled to run.
;
; The function displays appropriate error messages and warnings
; using the WRITE command. So, it MUST NOT be called from the
; pre-install or post-install routines.
;
; The function uses the ^UTILITY($J,"W") node (^DIWP and ^DIWW).
;
CHKOPT(OPTION) ;
N DIWF,DIWL,DIWR,RC,RORBUF,RORI,RORSDT,TMP,X,ZTSK
;--- Check status of the option
D OPTSTAT^XUTMOPT(OPTION,.RORBUF)
S (RC,RORSDT)=0
F RORI=1:1:$G(RORBUF) K ZTSK D I $G(ZTSK(1))=2 S RC=-76 Q
. S ZTSK=$P(RORBUF(RORI),"^") Q:'ZTSK
. D STAT^%ZTLOAD
. S TMP=$P(RORBUF(RORI),"^",2)
. I TMP>0 S:'RORSDT!(TMP<RORSDT) RORSDT=TMP
;--- Display an error message if the option is running
I RC D Q RC
. W !,$$MSG^RORERR20(RC,,,OPTION),!
;--- Display an apropriate warning
S DIWL=5,DIWR=$G(IOM,80)-DIWL
K ^UTILITY($J,"W")
CM1 I RORSDT>0 D
. ;;"The ["_OPTION_"] option is scheduled to run "_RORSDT_"."
. ;;"If you are going to schedule the installation, please, choose"
. ;;"an appropriate time so that the post-install will either"
. ;;"finish well before the ["_OPTION_"] scheduled time or start"
. ;;"after the option completion."
. ;---
. S RORSDT=$$FMTE^XLFDT(RORSDT)
. S RORSDT="on "_$P(RORSDT,"@")_" at "_$P(RORSDT,"@",2)
. F RORI=1:1 S X=$T(CM1+RORI) Q:X'[";;" D
. . X "S X="_$P(X,";;",2) D ^DIWP
CM2 E D
. ;;"The ["_OPTION_"] option is not scheduled. Do not forget"
. ;;"to schedule it after completion of the installation."
. ;---
. F RORI=1:1 S X=$T(CM2+RORI) Q:X'[";;" D
. . X "S X="_$P(X,";;",2) D ^DIWP
W ! D ^DIWW
Q 0
;
;***** 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 will complete the checkpoint.
;
; 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^RORERR(-50,,,,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^RORERR(-51,,,,CPNAME)
Q 0
;
;***** DELETES THE (SUB)FILE DD AND DATA (IF REQUESTED)
;
; FILE File 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 (except error messages if debug mode >1 is
; enabled) will be displayed on the console or stored
; into the INSTALLATION file.
;
; Return Values:
; <0 Error code
; 0 Ok
;
; NOTE: This entry point can also be called as a procedure:
; D DELFILE^RORKIDS(...) if you do not need its return value.
;
DELFILE(FILE,FLAGS,SILENT) ;
I '$$VFILE^DILFD(+FILE) Q:$QUIT 0 Q
N DIU,FT,RC
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:$QUIT 0 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 (except error messages if debug mode >1 is
; enabled) will be displayed on the console or stored
; into the INSTALLATION file.
;
; Return Values:
; <0 Error code
; 0 Ok
;
; NOTE: This entry point can also be called as a procedure:
; D DELFLDS^RORKIDS(...) if you do not need its return value.
;
DELFLDS(FILE,FLDLST,SILENT) ;
I '$$VFILE^DILFD(+FILE) Q:$QUIT 0 Q
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:$QUIT 0 Q
;
;***** OUTPUTS THE MESSAGE AND PUTS IT INTO THE LOG
MES(MSG,INFO) ;
N I
D MES^XPDUTL(" "_MSG)
S I=""
F S I=$O(INFO(I)) Q:I="" D MES^XPDUTL(" "_INFO(I))
D LOG^RORLOG(,MSG,,.INFO)
Q
;
;***** RETURNS A VALUE OF THE INSTALLATION PARAMETER
;
; NAME Name of the parameter
;
PARAM(NAME) ;
Q $G(RORPARM("KIDS",NAME))
;
;***** 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[HRORKIDS 8578 printed Dec 13, 2024@01:42:10 Page 2
RORKIDS ;HCIOFO/SG - INSTALL UTILITIES (LOW-LEVEL) ; 4/21/05 2:02pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** DISPLAYS THE MESSAGE IF THE INSTALLATION ABORTS
ABTMSG() ;
+1 ;;You can use the Print Log Files [RORMNT PRINT LOGS] option from
+2 ;;the Clinical Case Registries Maintenance [RORMNT MAIN] menu to
+3 ;;review the log file(s). The Install File Print [XPD PRINT INSTALL
+4 ;;FILE] option from the Utilities [XPD UTILITY] can help also.
+5 ;;Please fix the error(s) and restart the installation.
+6 ;;
+7 ;;NOTE: You must have the ROR VA IRM key to be able to access
+8 ;; the Clinical Case Registries files and view the logs.
+9 ;
+10 NEW I,INFO,MODE,TMP
+11 SET MODE=+$GET(RORPARM("KIDS"))
+12 SET MODE=$SELECT(MODE=1:"PRE-INSTALL",MODE=2:"POST-INSTALL",1:"")
+13 if MODE=""
QUIT
+14 FOR I=1:1
SET TMP=$TEXT(ABTMSG+I)
if TMP'[";;"
QUIT
SET INFO(I)=$PIECE(TMP,";;",2,99)
+15 DO BMES("FATAL ERROR(S) DURING THE REGISTRY "_MODE_"!",.INFO)
+16 QUIT
+17 ;
+18 ;***** SENDS AN ALERT
+19 ;
+20 ; DUZ DUZ of the addressee
+21 ;
+22 ; MSG Text of the message or negative error code. The '^'
+23 ; characters are replaced with spaces in the text.
+24 ;
+25 ; [REGNAME] Registry name
+26 ;
+27 ; [PATIEN] Patient IEN
+28 ;
+29 ; [ARG2-ARG5] Optional parameters as for $$ERROR^RORERR
+30 ;
ALERT(DUZ,MSG,REGNAME,PATIEN,ARG2,ARG3,ARG4,ARG5) ;
+1 if '$GET(DUZ)
QUIT
+2 NEW XQA,XQADATA,XQAFLG,XQAMSG,XQAROU,TMP
+3 SET XQA(DUZ)=""
+4 ;--- Get text of the error message
+5 IF +MSG=MSG
if MSG'<0
QUIT
Begin DoDot:1
+6 SET MSG=$$MSG^RORERR20(+MSG,,.PATIEN,.ARG2,.ARG3,.ARG4,.ARG5)
End DoDot:1
+7 SET MSG=$TRANSLATE(MSG,"^","~")
SET XQAMSG="ROR: "
SET TMP=70-$LENGTH(XQAMSG)-3
+8 SET XQAMSG=XQAMSG_$SELECT($LENGTH(MSG)>TMP:$EXTRACT(MSG,1,TMP)_"...",1:MSG)
+9 ;--- Setup alert processing routine
+10 SET $PIECE(XQADATA,U,1)=$EXTRACT(MSG,1,78)
+11 SET $PIECE(XQADATA,U,2)=$GET(REGNAME)
+12 SET $PIECE(XQADATA,U,3)=$GET(PATIEN)
+13 SET XQAROU="ALERTRTN^RORKIDS"
+14 ;--- Send the alert
+15 SET XQAFLG="D"
DO SETUP^XQALERT
+16 QUIT
+17 ;
+18 ;***** ALERT PROCESSING ROUTINE
+19 ;
+20 ; XQADATA Alert data
+21 ; ^1: Message
+22 ; ^2: Registry name
+23 ; ^3: Patient DFN
+24 ;
ALERTRTN ;
+1 ;;Registry Name:
+2 ;;Patient DFN:
+3 ;
+4 if $GET(XQADATA)=""
QUIT
+5 NEW I,TMP
+6 WRITE !!,$PIECE(XQADATA,"^"),!
+7 FOR I=1:1:2
SET TMP=$PIECE(XQADATA,"^",I+1)
if TMP'=""
Begin DoDot:1
+8 WRITE $PIECE($TEXT(ALERTRTN+I),";;",2),?15,TMP,!
End DoDot:1
+9 QUIT
+10 ;
+11 ;***** OUTPUTS THE MESSAGE AND PUTS IT INTO THE LOG
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 DO LOG^RORLOG(,MSG,,.INFO)
+6 QUIT
+7 ;
+8 ;***** CHECKS THE SCHEDULED OPTION
+9 ;
+10 ; OPTION Option name
+11 ;
+12 ; Return Values:
+13 ; <0 Error code
+14 ; 0 Ok
+15 ;
+16 ; This function can be used in the environment check routines to
+17 ; check if the option is running and/or scheduled to run.
+18 ;
+19 ; The function displays appropriate error messages and warnings
+20 ; using the WRITE command. So, it MUST NOT be called from the
+21 ; pre-install or post-install routines.
+22 ;
+23 ; The function uses the ^UTILITY($J,"W") node (^DIWP and ^DIWW).
+24 ;
CHKOPT(OPTION) ;
+1 NEW DIWF,DIWL,DIWR,RC,RORBUF,RORI,RORSDT,TMP,X,ZTSK
+2 ;--- Check status of the option
+3 DO OPTSTAT^XUTMOPT(OPTION,.RORBUF)
+4 SET (RC,RORSDT)=0
+5 FOR RORI=1:1:$GET(RORBUF)
KILL ZTSK
Begin DoDot:1
+6 SET ZTSK=$PIECE(RORBUF(RORI),"^")
if 'ZTSK
QUIT
+7 DO STAT^%ZTLOAD
+8 SET TMP=$PIECE(RORBUF(RORI),"^",2)
+9 IF TMP>0
if 'RORSDT!(TMP<RORSDT)
SET RORSDT=TMP
End DoDot:1
IF $GET(ZTSK(1))=2
SET RC=-76
QUIT
+10 ;--- Display an error message if the option is running
+11 IF RC
Begin DoDot:1
+12 WRITE !,$$MSG^RORERR20(RC,,,OPTION),!
End DoDot:1
QUIT RC
+13 ;--- Display an apropriate warning
+14 SET DIWL=5
SET DIWR=$GET(IOM,80)-DIWL
+15 KILL ^UTILITY($JOB,"W")
CM1 IF RORSDT>0
Begin DoDot:1
+1 ;;"The ["_OPTION_"] option is scheduled to run "_RORSDT_"."
+2 ;;"If you are going to schedule the installation, please, choose"
+3 ;;"an appropriate time so that the post-install will either"
+4 ;;"finish well before the ["_OPTION_"] scheduled time or start"
+5 ;;"after the option completion."
+6 ;---
+7 SET RORSDT=$$FMTE^XLFDT(RORSDT)
+8 SET RORSDT="on "_$PIECE(RORSDT,"@")_" at "_$PIECE(RORSDT,"@",2)
+9 FOR RORI=1:1
SET X=$TEXT(CM1+RORI)
if X'[";;"
QUIT
Begin DoDot:2
+10 XECUTE "S X="_$PIECE(X,";;",2)
DO ^DIWP
End DoDot:2
End DoDot:1
CM2 IF '$TEST
Begin DoDot:1
+1 ;;"The ["_OPTION_"] option is not scheduled. Do not forget"
+2 ;;"to schedule it after completion of the installation."
+3 ;---
+4 FOR RORI=1:1
SET X=$TEXT(CM2+RORI)
if X'[";;"
QUIT
Begin DoDot:2
+5 XECUTE "S X="_$PIECE(X,";;",2)
DO ^DIWP
End DoDot:2
End DoDot:1
+6 WRITE !
DO ^DIWW
+7 QUIT 0
+8 ;
+9 ;***** PROCESSES THE INSTALL CHECKPOINT
+10 ;
+11 ; CPNAME Checkpoint name
+12 ;
+13 ; CALLBACK Callback entry point ($$TAG^ROUTINE). This function
+14 ; accepts no parameters and must return either 0 if
+15 ; everything is Ok or a negative error code.
+16 ;
+17 ; [PARAM] Value to set checkpoint parameter to.
+18 ;
+19 ; The function checks if the checkpoint is completed. If it is not,
+20 ; the callback entry point is XECUTEd. If everything is Ok, the
+21 ; function will complete the checkpoint.
+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^RORERR(-50,,,,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^RORERR(-51,,,,CPNAME)
+14 QUIT 0
+15 ;
+16 ;***** DELETES THE (SUB)FILE DD AND DATA (IF REQUESTED)
+17 ;
+18 ; FILE File 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 (except error messages if debug mode >1 is
+29 ; enabled) will be displayed on the console or stored
+30 ; into the INSTALLATION file.
+31 ;
+32 ; Return Values:
+33 ; <0 Error code
+34 ; 0 Ok
+35 ;
+36 ; NOTE: This entry point can also be called as a procedure:
+37 ; D DELFILE^RORKIDS(...) if you do not need its return value.
+38 ;
DELFILE(FILE,FLAGS,SILENT) ;
+1 IF '$$VFILE^DILFD(+FILE)
if $QUIT
QUIT 0
QUIT
+2 NEW DIU,FT,RC
+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 if $QUIT
QUIT 0
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 (except error messages if debug mode >1 is
+21 ; enabled) will be displayed on the console or stored
+22 ; into the INSTALLATION file.
+23 ;
+24 ; Return Values:
+25 ; <0 Error code
+26 ; 0 Ok
+27 ;
+28 ; NOTE: This entry point can also be called as a procedure:
+29 ; D DELFLDS^RORKIDS(...) if you do not need its return value.
+30 ;
DELFLDS(FILE,FLDLST,SILENT) ;
+1 IF '$$VFILE^DILFD(+FILE)
if $QUIT
QUIT 0
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 if $QUIT
QUIT 0
QUIT
+10 ;
+11 ;***** OUTPUTS THE MESSAGE AND PUTS IT INTO THE LOG
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 DO LOG^RORLOG(,MSG,,.INFO)
+6 QUIT
+7 ;
+8 ;***** RETURNS A VALUE OF THE INSTALLATION PARAMETER
+9 ;
+10 ; NAME Name of the parameter
+11 ;
PARAM(NAME) ;
+1 QUIT $GET(RORPARM("KIDS",NAME))
+2 ;
+3 ;***** UPDATES THE FILE'S PACKAGE REVISION DATA (IF NECESSARY)
+4 ;
+5 ; FILE File number
+6 ;
+7 ; [PRD] Package revision data
+8 ; ^01: Revision number (N.N)
+9 ; ^02: Patch name
+10 ;
+11 ; If this entry point is called as a function, it returns the
+12 ; previous value of the PACKAGE REVISION DATA attribute.
+13 ;
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
