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

RORKIDS.m

Go to the documentation of this file. 
  1. RORKIDS ;HCIOFO/SG - INSTALL UTILITIES (LOW-LEVEL) ; 4/21/05 2:02pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** DISPLAYS THE MESSAGE IF THE INSTALLATION ABORTS
  1. ABTMSG() ;
  1.  ;;You can use the Print Log Files [RORMNT PRINT LOGS] option from
  1.  ;;the Clinical Case Registries Maintenance [RORMNT MAIN] menu to
  1.  ;;review the log file(s). The Install File Print [XPD PRINT INSTALL
  1.  ;;FILE] option from the Utilities [XPD UTILITY] can help also.
  1.  ;;Please fix the error(s) and restart the installation.
  1.  ;;
  1.  ;;NOTE: You must have the ROR VA IRM key to be able to access
  1.  ;;      the Clinical Case Registries files and view the logs.
  1.  ;
  1.  N I,INFO,MODE,TMP
  1.  S MODE=+$G(RORPARM("KIDS"))
  1.  S MODE=$S(MODE=1:"PRE-INSTALL",MODE=2:"POST-INSTALL",1:"")
  1.  Q:MODE=""
  1.  F I=1:1  S TMP=$T(ABTMSG+I)  Q:TMP'[";;"  S INFO(I)=$P(TMP,";;",2,99)
  1.  D BMES("FATAL ERROR(S) DURING THE REGISTRY "_MODE_"!",.INFO)
  1.  Q
  1.  ;
  1.  ;***** SENDS AN ALERT
  1.  ;
  1.  ; DUZ           DUZ of the addressee
  1.  ;
  1.  ; MSG           Text of the message or negative error code. The '^'
  1.  ;               characters are replaced with spaces in the text.
  1.  ;
  1.  ; [REGNAME]     Registry name
  1.  ;
  1.  ; [PATIEN]      Patient IEN
  1.  ;
  1.  ; [ARG2-ARG5]   Optional parameters as for $$ERROR^RORERR
  1.  ;
  1. ALERT(DUZ,MSG,REGNAME,PATIEN,ARG2,ARG3,ARG4,ARG5) ;
  1.  Q:'$G(DUZ)
  1.  N XQA,XQADATA,XQAFLG,XQAMSG,XQAROU,TMP
  1.  S XQA(DUZ)=""
  1.  ;--- Get text of the error message
  1.  I +MSG=MSG  Q:MSG'<0  D
  1.  . S MSG=$$MSG^RORERR20(+MSG,,.PATIEN,.ARG2,.ARG3,.ARG4,.ARG5)
  1.  S MSG=$TR(MSG,"^","~"),XQAMSG="ROR: ",TMP=70-$L(XQAMSG)-3
  1.  S XQAMSG=XQAMSG_$S($L(MSG)>TMP:$E(MSG,1,TMP)_"...",1:MSG)
  1.  ;--- Setup alert processing routine
  1.  S $P(XQADATA,U,1)=$E(MSG,1,78)
  1.  S $P(XQADATA,U,2)=$G(REGNAME)
  1.  S $P(XQADATA,U,3)=$G(PATIEN)
  1.  S XQAROU="ALERTRTN^RORKIDS"
  1.  ;--- Send the alert
  1.  S XQAFLG="D"  D SETUP^XQALERT
  1.  Q
  1.  ;
  1.  ;***** ALERT PROCESSING ROUTINE
  1.  ;
  1.  ; XQADATA       Alert data
  1.  ;                 ^1: Message
  1.  ;                 ^2: Registry name
  1.  ;                 ^3: Patient DFN
  1.  ;
  1. ALERTRTN ;
  1.  ;;Registry Name:
  1.  ;;Patient DFN:
  1.  ;
  1.  Q:$G(XQADATA)=""
  1.  N I,TMP
  1.  W !!,$P(XQADATA,"^"),!
  1.  F I=1:1:2  S TMP=$P(XQADATA,"^",I+1)  D:TMP'=""
  1.  . W $P($T(ALERTRTN+I),";;",2),?15,TMP,!
  1.  Q
  1.  ;
  1.  ;***** OUTPUTS THE MESSAGE AND PUTS IT INTO THE LOG
  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.  D LOG^RORLOG(,MSG,,.INFO)
  1.  Q
  1.  ;
  1.  ;***** CHECKS THE SCHEDULED OPTION
  1.  ;
  1.  ; OPTION        Option name
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1.  ; This function can be used in the environment check routines to
  1.  ; check if the option is running and/or scheduled to run.
  1.  ;
  1.  ; The function displays appropriate error messages and warnings
  1.  ; using the WRITE command. So, it MUST NOT be called from the
  1.  ; pre-install or post-install routines.
  1.  ;
  1.  ; The function uses the ^UTILITY($J,"W") node (^DIWP and ^DIWW).
  1.  ;
  1. CHKOPT(OPTION) ;
  1.  N DIWF,DIWL,DIWR,RC,RORBUF,RORI,RORSDT,TMP,X,ZTSK
  1.  ;--- Check status of the option
  1.  D OPTSTAT^XUTMOPT(OPTION,.RORBUF)
  1.  S (RC,RORSDT)=0
  1.  F RORI=1:1:$G(RORBUF)  K ZTSK  D  I $G(ZTSK(1))=2  S RC=-76  Q
  1.  . S ZTSK=$P(RORBUF(RORI),"^")  Q:'ZTSK
  1.  . D STAT^%ZTLOAD
  1.  . S TMP=$P(RORBUF(RORI),"^",2)
  1.  . I TMP>0  S:'RORSDT!(TMP<RORSDT) RORSDT=TMP
  1.  ;--- Display an error message if the option is running
  1.  I RC  D  Q RC
  1.  . W !,$$MSG^RORERR20(RC,,,OPTION),!
  1.  ;--- Display an apropriate warning
  1.  S DIWL=5,DIWR=$G(IOM,80)-DIWL
  1.  K ^UTILITY($J,"W")
  1. CM1 I RORSDT>0  D
  1.  . ;;"The ["_OPTION_"] option is scheduled to run "_RORSDT_"."
  1.  . ;;"If you are going to schedule the installation, please, choose"
  1.  . ;;"an appropriate time so that the post-install will either"
  1.  . ;;"finish well before the ["_OPTION_"] scheduled time or start"
  1.  . ;;"after the option completion."
  1.  . ;---
  1.  . S RORSDT=$$FMTE^XLFDT(RORSDT)
  1.  . S RORSDT="on "_$P(RORSDT,"@")_" at "_$P(RORSDT,"@",2)
  1.  . F RORI=1:1  S X=$T(CM1+RORI)  Q:X'[";;"  D
  1.  . . X "S X="_$P(X,";;",2)  D ^DIWP
  1. CM2 E  D
  1.  . ;;"The ["_OPTION_"] option is not scheduled. Do not forget"
  1.  . ;;"to schedule it after completion of the installation."
  1.  . ;---
  1.  . F RORI=1:1  S X=$T(CM2+RORI)  Q:X'[";;"  D
  1.  . . X "S X="_$P(X,";;",2)  D ^DIWP
  1.  W !  D ^DIWW
  1.  Q 0
  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 will complete the checkpoint.
  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^RORERR(-50,,,,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^RORERR(-51,,,,CPNAME)
  1.  Q 0
  1.  ;
  1.  ;***** DELETES THE (SUB)FILE DD AND DATA (IF REQUESTED)
  1.  ;
  1.  ; FILE          File 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 (except error messages if debug mode >1 is
  1.  ;               enabled) will be displayed on the console or stored
  1.  ;               into the INSTALLATION file.
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1.  ; NOTE: This entry point can also be called as a procedure:
  1.  ;       D DELFILE^RORKIDS(...) if you do not need its return value.
  1.  ;
  1. DELFILE(FILE,FLAGS,SILENT) ;
  1.  I '$$VFILE^DILFD(+FILE)  Q:$QUIT 0  Q
  1.  N DIU,FT,RC
  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:$QUIT 0  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 (except error messages if debug mode >1 is
  1.  ;               enabled) will be displayed on the console or stored
  1.  ;               into the INSTALLATION file.
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1.  ; NOTE: This entry point can also be called as a procedure:
  1.  ;       D DELFLDS^RORKIDS(...) if you do not need its return value.
  1.  ;
  1. DELFLDS(FILE,FLDLST,SILENT) ;
  1.  I '$$VFILE^DILFD(+FILE)  Q:$QUIT 0  Q
  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:$QUIT 0  Q
  1.  ;
  1.  ;***** OUTPUTS THE MESSAGE AND PUTS IT INTO THE LOG
  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.  D LOG^RORLOG(,MSG,,.INFO)
  1.  Q
  1.  ;
  1.  ;***** RETURNS A VALUE OF THE INSTALLATION PARAMETER
  1.  ;
  1.  ; NAME          Name of the parameter
  1.  ;
  1. PARAM(NAME) ;
  1.  Q $G(RORPARM("KIDS",NAME))
  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