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

XBBPI.m

Go to the documentation of this file. 
  1. XBBPI ; IHS/ADC/GTH - BUILD PACKAGE PRE-INIT ROUTINE ; [ 02/07/97   3:02 PM ]
  1.  ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
  1.  ;
  1.  ; This routine builds a pre-init routine for a specified
  1.  ; package. The pre-init routine will delete FileMan
  1.  ; dictionaries being created by the package.  Data
  1.  ; globals and templates will be saved.
  1.  ;
  1. START ;
  1.  D ^XBKVAR
  1.  W !!,"This routine will build a pre-init routine for the specified package."
  1.  W !,"The pre-init routine will call XBKD to delete the FileMan dictionaries"
  1.  W !,"being created by the package.  Data globals and templates will be saved.",!!
  1.  F XBBPLOOP=0:0 D PACKAGE Q:Y<0  D BUILD
  1.  KILL %,XBBPLOOP
  1.  Q
  1.  ;
  1. PACKAGE ;
  1.  S DIC="^DIC(9.4,",DIC(0)="AEMQ"
  1.  D ^DIC
  1.  KILL DIC
  1.  Q
  1.  ;
  1. BUILD ;
  1.  S XBBPDFN=+Y,XBBPPRFX=$P(^DIC(9.4,XBBPDFN,0),U,2),Y=DT
  1.  D DD^%DT
  1.  S XBBPVER=$G(^DIC(9.4,XBBPDFN,"VERSION"))_";"_$P(^DIC(9.4,XBBPDFN,0),U,1)_";;"_Y,XBBPPGM=XBBPPRFX_"PREI"
  1.  D CHECKRTN
  1.  I XBBPFLG D EOJ3 W !!,"Bye",! Q
  1.  KILL ^UTILITY("XBBPI",$J),^UTILITY("XBBPPGM",$J),^UTILITY("XBBPI EXEC",$J)
  1.  W "."
  1.  S (XBBPX,XBBPFLE)=0
  1.  F XBBPL=0:0 S XBBPFLE=$O(^DIC(9.4,XBBPDFN,4,"B",XBBPFLE)) Q:XBBPFLE'=+XBBPFLE  S ^UTILITY("XBBPI",$J,XBBPFLE)=""
  1.  W "."
  1.  S XBBPFLG=0,XBBPFLE=""
  1.  F XBBPL=0:0 S XBBPFLE=$O(^UTILITY("XBBPI",$J,XBBPFLE)) Q:XBBPFLE'=+XBBPFLE  I '$D(^DIC(XBBPFLE)) S XBBPFLG=1 W !,XBBPFLE," does not exist in ^DIC!"
  1.  I XBBPFLG W !!,"All files in package must exist.  Fix and rerun.",!! D EOJ Q
  1.  W "."
  1.  S XBBPFLE=""
  1.  F XBBPL=0:0 S XBBPFLE=$O(^UTILITY("XBBPI",$J,XBBPFLE)) Q:XBBPFLE'=+XBBPFLE  S ^(XBBPFLE)="^UTILITY(""XBDSET"",$J,"_XBBPFLE_")=S^S"
  1.  W "."
  1.  S %DT="",X="T"
  1.  D ^%DT
  1.  X ^DD("DD")
  1.  S ^UTILITY("XBBPPGM",$J,1,0)=XBBPPGM_" ; CREATED BY XBBPI ON "_Y
  1.  S ^UTILITY("XBBPPGM",$J,2,0)=" ;;"_XBBPVER
  1.  F XBBPI=1:1:3 S ^UTILITY("XBBPPGM",$J,XBBPI+2,0)=$P($T(DTA+XBBPI),";;",2,99)
  1.  S XBBPFLE=0
  1.  F XBBPI=6:1 S XBBPFLE=$O(^UTILITY("XBBPI",$J,XBBPFLE)) Q:XBBPFLE'=+XBBPFLE  S XBBPY=^(XBBPFLE),^UTILITY("XBBPPGM",$J,XBBPI,0)=" ;;"_XBBPY
  1.  S DIE="^UTILITY(""XBBPPGM"",$J,",X=XBBPPGM,XCN=0
  1.  X ^%ZOSF("SAVE")
  1.  D EOJ
  1.  Q
  1.  ;
  1. CHECKRTN ;
  1.  S XBBPFLG=0
  1.  Q:'$D(^DD("OS"))#2
  1.  Q:'$D(^DD("OS",^DD("OS"),18))#2  S X=XBBPPGM X ^(18)
  1.  E  Q
  1. CR2 ;
  1.  W !!,XBBPPGM," already exists.  Want to recreate it (Y/N) Y//"
  1.  D YN^DICN
  1.  S:$E(%Y)="N" XBBPFLG=1
  1.  Q
  1.  ;
  1. EOJ ;
  1.  W !!,"Routine ",XBBPPGM," has been filed.",!!
  1.  I '$D(^DIC(9.4,XBBPDFN,"INI")) D EOJ2
  1.  I $D(^DIC(9.4,XBBPDFN,"INI")),$P(^("INI"),U)="" D EOJ2 I 1
  1.  E  I $D(^DIC(9.4,XBBPDFN,"INI")),$P(^("INI"),U)'=XBBPPGM W !!,"Package ",XBBPPRFX," has a pre-initialization routine entry but it is ",$P(^("INI"),U),"!"
  1.  D EOJ3
  1.  Q
  1.  ;
  1. EOJ2 ;
  1.  W !,"Package ",XBBPPRFX," has no pre-initialization routine entry!",!
  1.  Q
  1.  ;
  1. EOJ3 ;
  1.  KILL ^UTILITY("XBBPI",$J),^UTILITY("XBBPPGM",$J),^UTILITY("XBBPI EXEC",$J)
  1.  KILL %,%DT,DIE,XCN
  1.  KILL XBBPDFN,XBBPFLE,XBBPFLG,XBBPI,XBBPL,XBBPP,XBBPPGM,XBBPPRFX,XBBPX,XBBPY,XBBPVER
  1.  Q
  1.  ;
  1. DTA ;
  1.  ;; K ^UTILITY("XBDSET",$J) F XBBPI=1:1 S XBBPIX=$P($T(Q+XBBPI),";;",2) Q:XBBPIX=""  S XBBPIY=$P(XBBPIX,"=",2,99),XBBPIX=$P(XBBPIX,"=",1) S @XBBPIX=XBBPIY
  1.  ;; K XBBPI,XBBPIX,XBBPIY D EN2^XBKD
  1.  ;;Q Q