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

ZIBCKPKG.m

Go to the documentation of this file. 
  1. ZIBCKPKG ; IHS/ADC/GTH - CHECK UCI FOR PACKAGE CONTENT ; [ 10/29/2002   7:42 AM ]
  1.  ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
  1.  ;
  1.  ;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Change MSM systax to use $ROUTINE.
  1.  D INIT
  1.  S XBQUEST=1 D ASKIT G:XBQ=U EXIT S XBINPR=XBQ
  1.  S XBQUEST=2 D ASKIT G:XBQ=U EXIT S XBLC=XBQ
  1.  S XBQUEST=3 D ASKIT G:XBQ=U EXIT S XBLNPR=XBQ
  1.  ;
  1. ZIS ; SELECT DEVICE
  1.  KILL ZTSK,IOP,%ZIS
  1.  S %ZIS="PQM"
  1.  D ^%ZIS
  1.  G:POP EXIT
  1.  G:$D(IO("Q")) QUE
  1. NOQUE ;
  1.  U IO
  1.  D EN
  1.  D ^%ZISC
  1.  G EXIT
  1.  ;
  1. QUE ;
  1.  KILL ZTSAVE
  1.  F %="XBINPR","XBLNPR","XBLC" S ZTSAVE(%)=""
  1.  S ZTRTN="EN^ZIBCKPKG",ZTDESC="SCAN UCI FOR PACKAGES",ZTIO=IO,ZTDTH=0
  1.  D ^%ZTLOAD
  1.  KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1. EXIT ;
  1.  D KILLS
  1.  Q
  1.  ;
  1. EN1 ; ENTRY FOR SILENT OPERATION
  1.  D INIT
  1.  S (XBINPR,XBLC)=1
  1.  G EN
  1.  ;
  1. INIT ; INITIALIZATION
  1.  S U="^"
  1.  S:'$D(DTIME) DTIME=300
  1.  Q
  1.  ;
  1. EN ; COMMON INTERNAL ENTRY
  1.  S XBQUIT=0
  1.  KILL ^UTILITY($J,"ZIBCKPKG")
  1.  D SCAN
  1.  Q:XBQUIT
  1.  D:XBLNPR SHOWNPR
  1.  D:XBLC SHOWLC
  1.  I $D(IOST),$D(IOF),$E(IOST,1,2)="P-" W @IOF
  1.  SET:$D(ZTQUEUED) ZTREQ="@"
  1. KILLS ;
  1.  KILL XBINPR,XBRNPR,XBLNPR,XBLC,XBQUIT,XBR,XBR2,XBPF,XBI,XBJ,XBP,XBQ,XBCNT,XBQUEST
  1.  KILL ^UTILITY($J,"ZIBCKPKG"),ZTSK
  1.  Q
  1.  ;
  1. SCAN ;
  1.  X ^%ZOSF("UCI")
  1.  W "- - - PACKAGE SCAN OF UCI ",Y,$S($D(^DD("SITE")):" ON "_^("SITE"),1:"")," - - -",!!
  1.  ; S XBR=$O(^ ("%zzzzzzz")) ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  S XBR=$O(^$R("%zzzzzzz")) ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  F  Q:XBR=""  Q:XBR?1L.E  D CHKPKG Q:XBQUIT
  1.  Q:XBQUIT
  1.  F  Q:XBR=""  D GETNXT
  1.  Q
  1.  ;
  1. CHKPKG ; CHECK FOR PACKAGE
  1.  S XBPF=$E(XBR,1,4)
  1.  F XBI=$L(XBPF):-1:0 S XBPF=$E(XBPF,1,XBI) Q:XBPF=""  S XBP=$O(^DIC(9.4,"C",XBPF,0)) Q:XBP
  1.  I XBPF=""  D NOTPKG Q
  1.  W XBPF,?4," - ",$P(^DIC(9.4,XBP,0),U,1)
  1.  S XBRNPR=0
  1.  D SKIP
  1.  W " (",XBCNT,")",!
  1.  Q
  1.  ;
  1. NOTPKG ;
  1.  I XBINPR S ^UTILITY($J,"ZIBCKPKG",2,XBR)="" S XBPF="" D GETNXT Q
  1.  F  W XBR R " -- Package prefix? ",XBPF:DTIME S:'$T XBPF=U Q:XBPF[U  D GETPKG Q:XBPF'="-"
  1.  I XBPF[U S XBQUIT=1 Q
  1.  W !
  1.  I XBPF="" D GETNXT Q
  1.  S XBI=$L(XBPF),XBRNPR=1
  1.  D SKIP
  1.  W " ",XBCNT," ROUTINES SKIPPED.",!
  1.  Q
  1.  ;
  1. GETPKG ;
  1.  I XBPF?1."?" S XBQUEST=4 D DSPHLP W ! S XBPF="-" Q
  1.  I XBPF?1."?"1.E D DSPLY S XBPF="-" Q
  1.  Q:XBPF'?.E1CL.E&($L(XBPF)<5)
  1.  W " -- Package id must be upper case, length 1-4",!
  1.  S XBPF="-"
  1.  Q
  1.  ;
  1. SKIP ;
  1.  F XBCNT=1:1 S:XBRNPR ^UTILITY($J,"ZIBCKPKG",2,XBR)="" D GETNXT Q:$E(XBR,1,XBI)'=XBPF
  1.  Q
  1.  ;
  1. GETNXT ;
  1.  S:XBR?.E1L.E ^UTILITY($J,"ZIBCKPKG",1,XBR)=""
  1.  ; S XBR=$O(^ (XBR)) ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  S XBR=$O(^$R(XBR)) ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  Q
  1.  ;
  1. DSPLY ;
  1.  S (XBPF,XBR2)=$E(XBPF,2,$L(XBPF))
  1.  W !
  1.  S XBJ=0
  1.  S X=XBR2
  1.  X ^%ZOSF("TEST")
  1.  I  S XBJ=1 W !,XBR2
  1.  ; F XBJ=XBJ:1 S XBR2=$O(^ (XBR2)) Q:$E(XBR2,1,$L(XBPF))'=XBPF  W:XBJ#8=0 ! W ?XBJ#8*10,XBR2 ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  F XBJ=XBJ:1 S XBR2=$O(^$R(XBR2)) Q:$E(XBR2,1,$L(XBPF))'=XBPF  W:XBJ#8=0 ! W ?XBJ#8*10,XBR2 ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  W:$X !
  1.  W !
  1.  Q
  1.  ;
  1. SHOWNPR ;
  1.  Q:'$D(^UTILITY($J,"ZIBCKPKG",2))
  1.  W !!,"Non-package routines:",!
  1.  S XBR2=""
  1.  F XBJ=0:1 S XBR2=$O(^UTILITY($J,"ZIBCKPKG",2,XBR2)) Q:XBR2=""  W:XBJ#8=0 ! W ?XBJ#8*10,XBR2
  1.  W !
  1.  Q
  1.  ;
  1. SHOWLC ;
  1.  Q:'$D(^UTILITY($J,"ZIBCKPKG",1))
  1.  W !!,"Routine names containing lower case letters:",!
  1.  S XBR2=""
  1.  F XBJ=0:1 S XBR2=$O(^UTILITY($J,"ZIBCKPKG",1,XBR2)) Q:XBR2=""  W:XBJ#8=0 ! W ?XBJ#8*10,XBR2
  1.  W !
  1.  Q
  1.  ;
  1. ASKIT ; ASK A YES/NO QUESTION
  1.  KILL XBQ
  1.  S %=$T(@XBQUEST),XBQ("Q")=$P(%,";;",2),XBQ("D")=$P(%,";;",3)
  1. ASKIT2 ;
  1.  W !,XBQ("Q")," ",XBQ("D"),"// "
  1.  R XBQ:DTIME
  1.  S:'$T XBQ=U
  1.  I XBQ="" S XBQ=XBQ("D") W XBQ
  1.  S XBQ("R")=XBQ,XBQ=""
  1.  I XBQ("R")[U S XBQ=U
  1.  I $P("YES",XBQ("R"))="" S XBQ=1
  1.  I $P("yes",XBQ("R"))="" S XBQ=1
  1.  I $P("NO",XBQ("R"))="" S XBQ=0
  1.  I $P("no",XBQ("R"))="" S XBQ=0
  1.  I XBQ]"" W ! Q
  1.  W !,"-- Please answer YES or NO"
  1.  D DSPHLP
  1.  G ASKIT
  1.  ;
  1. DSPHLP ;
  1.  F XBI=1:1 S %=$T(@XBQUEST+XBI) Q:%=""  Q:$P(%," ")]""  W !,"-- ",$P(%,";;",2)
  1.  W !
  1.  KILL %
  1.  Q
  1.  ;
  1. QUEST ;
  1.  ;
  1. 1 ;;Ignore non-package routines?;;YES
  1.  ;;Responding NO will cause you to be asked if a routine for which
  1.  ;;a namespace cannot be identified in the package file can be
  1.  ;;considered part of a "psuedo-package" with which a namespace can
  1.  ;;be associated.
  1. 2 ;;Display routine names containing lower case letters?;;YES
  1.  ;;Responding YES will cause a tabular listing to be produced
  1.  ;;displaying all routine names which contain a lower case letter.
  1. 3 ;;Display names of non-package routines?;;YES
  1.  ;;Responding YES will cause a tabular listing to be produced
  1.  ;;displaying the names of all routines which were not found
  1.  ;;to be part of a package.
  1. 4 ;;
  1.  ;;If you enter a namespace, routines will be processed as though a
  1.  ;;formal package association was made.