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

DIPR162.m

Go to the documentation of this file. 
  1. DIPR162 ;O-OIFO/GMB-Correct NOW function ;8/31/2009
  1.  ;;22.0;VA FileMan;**162**;Mar 30, 1999;Build 21
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ENV ; Environmental Check
  1.  D BMES^XPDUTL("Perform Environment Check...")
  1.  D CHKSTOP
  1.  D BMES^XPDUTL("Finished Environment Check.")
  1.  Q
  1. CHKSTOP ;
  1.  ; Check XPDENV 0 = Loading; 1 = Installing
  1.  Q:'XPDENV  ; Loading Distribution - No Check
  1.  ;
  1.  ;
  1. INSCHK ; Do Checks During Install Only
  1.  W $C(7)
  1.  D MES^XPDUTL("** Although Queuing is allowed - it is HIGHLY recommended that ALL Users and")
  1.  D MES^XPDUTL("VISTA Background jobs be STOPPED before installation of this patch.  Failure")
  1.  D MES^XPDUTL("to do so may result in 'source routine edited' error(s). Edits will be")
  1.  D MES^XPDUTL("lost and record(s) may be left in an inconsistent state, for example,")
  1.  D MES^XPDUTL("not all Cross-Referencing completed; which in turn may cause FUTURE")
  1.  D MES^XPDUTL("VistA/FileMan Hard Errors or corrupted Data. **")
  1.  ;
  1. TMCHK ; Check to see if TaskMan is still running
  1.  S X=$$TM^%ZTLOAD
  1.  I X,'$D(^%ZTSCH("WAIT")) D
  1.  . W $C(7)
  1.  . D BMES^XPDUTL("* Warning TaskMan Has NOT Been Stopped or Placed in a WAIT State!")
  1.  ;
  1. LINH ; Check to see if Logons are Inhibited
  1.  D GETENV^%ZOSV  ; $P(Y,"^",2) = Installing Volume
  1.  Q:$G(^%ZIS(14.5,"LOGON",$P(Y,"^",2)))
  1.  W $C(7)
  1.  D BMES^XPDUTL("* Warning Logons are NOT Inhibited!")
  1.  Q
  1. POSTINIT ; Post-Init
  1.  D BMES^XPDUTL("Beginning Post-Installation...")
  1.  D BMES^XPDUTL("  I am saving routine DIDT as %DT.")
  1.  N SCR,%S,%D,ZTOS
  1.  S SCR="I 1",ZTOS=$$OSNUM^ZTMGRSET,%S="DIDT",%D="%DT" D MOVE^ZTMGRSET
  1.  N NOWX,TODAYX
  1.  S NOWX("BEFORE")="S %=$P($H,"","",2),X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100)"
  1.  S NOWX("AFTER")="N %I,%H,% D NOW^%DTC S X=%"
  1.  S TODAYX("BEFORE")="S X=DT"
  1.  S TODAYX("AFTER")="N %I,%H,% D NOW^%DTC"
  1.  I $G(^DD("FUNC",24,1))=NOWX("AFTER") D
  1.  . D BMES^XPDUTL("  The NOW function has already been corrected. No action taken.")
  1.  E  D
  1.  . D BMES^XPDUTL("  I am changing ^DD(""FUNC"",24,1) to correct the NOW function.")
  1.  . S ^DD("FUNC",24,1)=NOWX("AFTER")
  1.  I $G(^DD("FUNC",25,1))=TODAYX("AFTER") D
  1.  . D BMES^XPDUTL("  The TODAY function has already been corrected. No action taken.")
  1.  E  D
  1.  . D BMES^XPDUTL("  I am changing ^DD(""FUNC"",25,1) to correct the TODAY function.")
  1.  . S ^DD("FUNC",25,1)=TODAYX("AFTER")
  1.  D FIND
  1.  D BMES^XPDUTL("Finished Post-Installation.")
  1.  Q
  1. FIND ; Find and replace NOW and TODAY code in triggers
  1.  D BMES^XPDUTL("  I am finding and replacing all NOW and TODAY code in triggers.")
  1.  N FILE,FLD,IEN,LINE,FLAG,CNT
  1.  S (FILE,CNT)=0
  1.  F  S FILE=$O(^DD(FILE)) Q:'FILE  D
  1.  . S FLD=0
  1.  . F  S FLD=$O(^DD(FILE,FLD)) Q:'FLD  D
  1.  . . S IEN=0
  1.  . . F  S IEN=$O(^DD(FILE,FLD,1,IEN)) Q:'IEN  D
  1.  . . . S FLAG=0
  1.  . . . I $G(^DD(FILE,FLD,1,IEN,"CREATE VALUE"))="NOW" D REPLACE("NOW","CREATE",1,.NOWX)
  1.  . . . I $G(^DD(FILE,FLD,1,IEN,"CREATE VALUE"))="TODAY" D REPLACE("TODAY","CREATE",1,.TODAYX)
  1.  . . . I $G(^DD(FILE,FLD,1,IEN,"DELETE VALUE"))="NOW" D REPLACE("NOW","DELETE",2,.NOWX)
  1.  . . . I $G(^DD(FILE,FLD,1,IEN,"DELETE VALUE"))="TODAY" D REPLACE("TODAY","DELETE",2,.TODAYX)
  1.  D BMES^XPDUTL("  I have replaced the NOW and TODAY code in "_CNT_" triggers.")
  1.  Q
  1. REPLACE(FUNC,VAL,NODE,CODE) ;
  1.  N LINE,P1,P2,START,STOP
  1.  S START=NODE-.00001,STOP=NODE+.39999,NODE=START
  1.  F  S NODE=$O(^DD(FILE,FLD,1,IEN,NODE)) Q:'NODE!(NODE>STOP)  D
  1.  . S LINE=$G(^DD(FILE,FLD,1,IEN,NODE))
  1.  . Q:LINE'[CODE("BEFORE")
  1.  . I 'FLAG D
  1.  . . S FLAG=1
  1.  . . S CNT=CNT+1
  1.  . . D BMES^XPDUTL("  For TRIGGER at ^DD("_FILE_","_FLD_",1,"_IEN_", change:")
  1.  . D MES^XPDUTL("  "_FUNC_" code in node "_NODE_")")
  1.  . D MES^XPDUTL("    from: "_LINE)
  1.  . S P1=$P(LINE,CODE("BEFORE"),1)
  1.  . S P2=$P(LINE,CODE("BEFORE"),2)
  1.  . S LINE=P1_CODE("AFTER")_P2
  1.  . S ^DD(FILE,FLD,1,IEN,NODE)=LINE
  1.  . D MES^XPDUTL("      to: "_LINE)
  1.  Q