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

SCMSPU2.m

Go to the documentation of this file. 
  1. SCMSPU2 ;ALB/JRP - UTILITIES FOR INSTALLING EXPORTED ROUTINES;24-AUG-93
  1.  ;;5.3;Scheduling;**44**;AUG 13, 1993
  1.  ;
  1. EXIST(X) ;DETERMINE IF ROUTINE X EXISTS
  1.  ;INPUT  : X - Name of routine
  1.  ;OUTPUT : 1 - Routine exists
  1.  ;         0 - Routine doesn't exist
  1.  ;        "" - Error
  1.  ;
  1.  ;CHECK INPUT & EXISTANCE OF ^%ZOSF("TEST")
  1.  Q:($G(X)="") ""
  1.  Q:('$D(^%ZOSF("TEST"))) ""
  1.  ;CHECK FOR EXISTANCE
  1.  X ^%ZOSF("TEST") Q $T
  1.  ;
  1. LOAD(X,ARRAY) ;LOAD ROUTINE X INTO ARRAY
  1.  ;INPUT  : X - Name of routine
  1.  ;         ARRAY - Array to copy into (full global reference)
  1.  ;OUTPUT : None
  1.  ;NOTES  : ARRAY will be in the format
  1.  ;           ARRAY(Line_N,0)=Line number N of routine X
  1.  ;       : ARRAY will be killed before loading routine.  If routine
  1.  ;         could not be loaded, ARRAY() will not exit.
  1.  ;
  1.  ;CHECK INPUT, KILL ARRAY, TEST FOR ^%ZOSF("LOAD")
  1.  Q:($G(ARRAY)="")
  1.  K @ARRAY
  1.  Q:($G(X)="")
  1.  Q:('$D(^%ZOSF("LOAD")))
  1.  ;DECLARE VARIABLES
  1.  N XCNP,DIF,TMP,TMP1,TMP2
  1.  ;SET REQUIRED VARIABLES
  1.  S TMP=$P(ARRAY,"(",1)
  1.  S TMP1=$P(ARRAY,"(",2)
  1.  S TMP2=$P(TMP1,")",1)
  1.  S:(TMP2="") DIF=TMP_"("
  1.  S:(TMP2'="") DIF=TMP_"("_TMP2_","
  1.  S XCNP=0
  1.  ;LOAD ROUTINE
  1.  X ^%ZOSF("LOAD")
  1.  Q
  1.  ;
  1. COPY(OLDROU,NEWROU,XCN) ;COPY ROUTINE OLDROU TO ROUTINE NEWROU
  1.  ;INPUT  : OLDROU - Name of existing routine
  1.  ;         NEWROU - New name for routine
  1.  ;         XCN - Line in existing routine to begin copying from
  1.  ;               (defaults to line 1)
  1.  ;OUTPUT : 0 - Success
  1.  ;        -1 - Error
  1.  ;
  1.  ;CHECK INPUT & EXISTANCE OF ^%ZOSF("SAVE")
  1.  Q:($G(OLDROU)="") -1
  1.  Q:($G(NEWROU)="") -1
  1.  S XCN=+$G(XCN)
  1.  Q:('$D(^%ZOSF("SAVE"))) -1
  1.  ;CHECK FOR EXISTANCE OF OLDROU
  1.  Q:('$$EXIST(OLDROU)) -1
  1.  ;DECLARE VARIABLES
  1.  N ROOT1,ROOT2,X,DIE
  1.  S ROOT1="^UTILITY(""SCMSPST"","_$J_")"
  1.  S ROOT2="^UTILITY(""SCMSPST"","_$J_","
  1.  K @ROOT1
  1.  ;LOAD OLDROU
  1.  D LOAD(OLDROU,ROOT1)
  1.  Q:('$D(@ROOT1)) -1
  1.  ;CALL TO ^%ZOSF("SAVE") START WITH LINE AFTER XCN.  SUBTRACT
  1.  ; ONE FROM THE VALUE PASSED TO MATCH STATED VALUE.
  1.  S XCN=XCN-1
  1.  ;SAVE OLDROU AS NEWROU
  1.  S X=NEWROU
  1.  S DIE=ROOT2
  1.  X ^%ZOSF("SAVE")
  1.  K @ROOT1
  1.  ;HAVE TO ASSUME THAT SAVE WAS SUCCESSFUL
  1.  Q 0
  1.  ;
  1. SECOND(ROU,STRIP) ;RETURN SECOND LINE OF ROUTINE ROU
  1.  ;INPUT  : ROU - Name of routine
  1.  ;         STRIP - Flad indicating of leading <TAB>; should be stripped
  1.  ;           If 1, strip <TAB>;  (default)
  1.  ;           If 0, don't strip <TAB>;
  1.  ;OUTPUT : Second line of ROU
  1.  ;         NULL returned on error
  1.  ;
  1.  ;CHECK INPUT
  1.  Q:($G(ROU)="") ""
  1.  Q:('$$EXIST(ROU)) ""
  1.  S:($G(STRIP)="") STRIP=1
  1.  ;DECLARE VARIABLES
  1.  N ROOT,LINE2
  1.  S ROOT="^UTILITY(""VAQPST"","_$J_")"
  1.  ;LOAD ROUTINE
  1.  D LOAD(ROU,ROOT)
  1.  Q:('$D(@ROOT)) ""
  1.  ;GET SECOND LINE
  1.  S LINE2=$G(@ROOT@(2,0))
  1.  ;STRIP LEADING <TAB>;
  1.  S:(STRIP) LINE2=$P(LINE2,";;",2,$L(LINE2,";;"))
  1.  K @ROOT
  1.  Q LINE2