source: IHS-VA_UTILITIES-XB/ZIBFMD.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 14 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 4.3 KB
Line 
1ZIBFMD ; IHS/ADC/GTH - DISPLAY FILEMAN INSTALLATION DATA ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
4 ;
5 W "Listing of known FileMan Site ID's",!
6SETUP ;
7 D ^XBKVAR
8 S DTIME=300
9 KILL %,DISYS,%H,X,^TMP("ZIBFMD",$J)
10 S IOP=$I
11 D ^%ZIS
12ZIS ;
13 KILL ZTSK,IOP,%ZIS
14 S %ZIS="PQM"
15 D ^%ZIS
16 G:POP EXIT
17 G:$D(IO("Q")) QUE
18NOQUE ;
19 I IO'=IO(0) W "Printing now ...",!
20 U IO
21 D EN
22 D ^%ZISC
23 Q
24 ;
25QUE ;
26 KILL ZTSAVE
27 ; S ZTRTN="EN^ZIBFMD",ZTDESC="FILEMAN ID'S BY UCI",ZTIO=IO,ZTDTH=DT ;IHS/SET/GTH XB*3*9 10/29/2002
28 S ZTRTN="EN^ZIBFMD",ZTDESC="FILEMAN ID'S BY "_$S($$VERSION^%ZOSV(1)["Cache":"NAMESPACE",1:"UCI"),ZTIO=IO,ZTDTH=DT ;IHS/SET/GTH XB*3*9 10/29/2002
29 D ^%ZTLOAD
30 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
31 Q
32 ;
33EN ;EP - From TaskMan. Common processing for tasked or direct mode.
34SCAN ;
35 D HDR
36 ; W "Fileman Site IDs by UCI:",! ;IHS/SET/GTH XB*3*9 10/29/2002
37 W "Fileman Site IDs by ",$S($$VERSION^%ZOSV(1)["Cache":"Namespace",1:"UCI"),":",! ;IHS/SET/GTH XB*3*9 10/29/2002
38 S X="NMUCI^ZIBFMD",@^%ZOSF("TRAP")
39 ;Begin New Code;IHS/SET/GTH XB*3*9 10/29/2002
40 I $$VERSION^%ZOSV(1)["Cache" D G NMUCI
41 . F I=1:1:$ZU(90,0) S ZIBLIST($ZU(90,2,0,I))=""
42 . S ZIBFUCI=""
43 . F S ZIBFUCI=$O(ZIBLIST(ZIBFUCI)) Q:ZIBFUCI="" D:"%SYS%CACHELIBSAMPLES"'[ZIBFUCI SHOW
44 .Q
45 ;End New Code;IHS/SET/GTH XB*3*9 10/29/2002
46 F ZIBFI=1:1 S ZIBFUCI=$ZU(ZIBFI) Q:ZIBFUCI="" D:$P(ZIBFUCI,U,1)'="MGR" SHOW
47NMUCI ;
48 S X="",@^%ZOSF("TRAP")
49DSPLY ;
50 D SUMM,SHOWF
51 G EXIT
52 ;
53HDR ;
54 D NOW^%DTC
55 S Y=%,DT=$P(Y,".",1)
56 X:$D(^DD("DD")) ^("DD")
57 S ZIBFTDY=$P(Y,":",1,2)
58 X ^%ZOSF("UCI")
59 S ZIBFHDR(1)="UCI: "_Y_" CPU: "_^%ZOSF("VOL")_" "_ZIBFTDY,ZIBFHDR="F i l e M a n I n s t a l l a t i o n D a t a "
60 W @IOF,!,?IOM-$L(ZIBFHDR)\2,ZIBFHDR,!,?IOM-$L(ZIBFHDR(1))\2,ZIBFHDR(1),!!
61 Q
62 ;
63SHOW ;
64 W ?1,ZIBFUCI,?15
65 S X="DDPROT",@^%ZOSF("TRAP")
66 I '$D(^[ZIBFUCI]DD) W "--",?50,"No ^DD global!",! Q
67 ; I '$D(^[ZIBFUCI]DD("SITE")) W "-- No ^DD(""ZIBFSITE"")!",! Q ;IHS/SET/GTH XB*3*9 10/29/2002
68 I '$D(^[ZIBFUCI]DD("SITE")) W "-- No ^DD(""SITE"")!",! Q ;IHS/SET/GTH XB*3*9 10/29/2002
69 S ZIBFNAME=^[ZIBFUCI]DD("SITE")
70 W ZIBFNAME,?50
71 ; I '$D(^[ZIBFUCI]DD("SITE",1)) W "--",?50,"No ^DD(""ZIBFSITE"",1)!",! Q ;IHS/SET/GTH XB*3*9 10/29/2002
72 I '$D(^[ZIBFUCI]DD("SITE",1)) W "--",?50,"No ^DD(""SITE"",1)!",! Q ;IHS/SET/GTH XB*3*9 10/29/2002
73 S ZIBFNUM=^[ZIBFUCI]DD("SITE",1)
74 W ZIBFNUM,!
75 F %=1:1 I '$D(^TMP("ZIBFMD",$J,"ID",ZIBFNUM,%)) S ^(%)=ZIBFUCI_" : "_ZIBFNAME Q
76 S ^TMP("ZIBFMD",$J,"UCI",ZIBFUCI)=ZIBFNUM
77 Q
78 ;
79DDPROT ;
80 W "--",?50,"Cannot access ^DD [protection]!",!
81 Q
82 ;
83SUMM ;
84 W !!,"Summary of known FileMan system ID's:",!
85 F ZIBFI=0:0 S ZIBFI=$O(^TMP("ZIBFMD",$J,"ID",ZIBFI)) Q:'ZIBFI W ?1,$J(ZIBFI,4) F %=1:1 Q:'$D(^TMP("ZIBFMD",$J,"ID",ZIBFI,%)) W ?7,^(%),!
86 Q
87 ;
88SHOWF ;
89 ; W !!,"Listing of locally-developed files by UCI:",! ;IHS/SET/GTH XB*3*9 10/29/2002
90 W !!,"Listing of locally-developed files by ",$S($$VERSION^%ZOSV(1)["Cache":"Namespace",1:"UCI"),":",! ;IHS/SET/GTH XB*3*9 10/29/2002
91 S ZIBFUCI=""
92 F S ZIBFUCI=$O(^TMP("ZIBFMD",$J,"UCI",ZIBFUCI)) Q:ZIBFUCI="" S ZIBFNUM=^(ZIBFUCI) D SHOWF2
93 Q
94 ;
95SHOWF2 ;
96 W ?1,ZIBFUCI
97 S $ZT="NODIC^ZIBFMD",ZIBFF1=ZIBFNUM*1000,ZIBFF2=ZIBFF1+1000
98 ;I $D(^[ZIBFUCI]DIC(ZIBFF1,0)) D SHOWF3($P(^[ZIBFUCI]DIC(ZIBFF1,0),U)) ;IHS/SET/GTH XB*3*9 10/29/2002
99 I $D(^[ZIBFUCI]DIC(ZIBFF1,0)) D SHOWF3($P(^[ZIBFUCI]DIC(ZIBFF1,0),U),^[ZIBFUCI]DIC(ZIBFF1,0,"GL")) ;IHS/SET/GTH XB*3*9 10/29/2002
100 ;F S ZIBFF1=$O(^[ZIBFUCI]DIC(ZIBFF1,ZIBFF1)) Q:'ZIBFF1 Q:ZIBFF1'<ZIBFF2 D SHOWF3($P(^[ZIBFUCI]DIC(ZIBFF1,ZIBFF1),U)) ;IHS/SET/GTH XB*3*9 10/29/2002
101 F S ZIBFF1=$O(^[ZIBFUCI]DIC(ZIBFF1)) Q:'ZIBFF1 Q:ZIBFF1>ZIBFF2 D SHOWF3($P(^[ZIBFUCI]DIC(ZIBFF1,0),U),^[ZIBFUCI]DIC(ZIBFF1,0,"GL")) ;IHS/SET/GTH XB*3*9 10/29/2002
102 W:$X !
103 S X="",@^%ZOSF("TRAP")
104 Q
105 ;
106NODIC ;
107 W ?15,"--",?30,"Cannot access ^DIC (protection)",!
108 Q
109 ;
110SHOWF3(X,Y) ;IHS/SET/GTH XB*3*9 10/29/2002 Added parameter "Y".
111 ;W ?15,ZIBFF1,?30,X,! ;IHS/SET/GTH XB*3*9 10/29/2002
112 W ?15,ZIBFF1,?30,X,?45,Y,! ;IHS/SET/GTH XB*3*9 10/29/2002
113 Q
114 ;
115EXIT ;
116 ;KILL X,ZIBFI,ZIBFUCI,ZIBFNAME,ZIBFNUM,ZIBFHDR,ZIBFF1,ZIBFF2,ZIBFTDY,%I,%H,DTOUT,DUOUT,^TMP("ZIBFMD",$J) ;IHS/SET/GTH XB*3*9 10/29/2002
117 KILL X,ZIBFI,ZIBFUCI,ZIBGBL,ZIBFNAME,ZIBFNUM,ZIBFHDR,ZIBFF1,ZIBFF2,ZIBFTDY,%I,%H,DTOUT,DUOUT,^TMP("ZIBFMD",$J) ;IHS/SET/GTH XB*3*9 10/29/2002
118 S:$D(ZTQUEUED) ZTREQ="@"
119 Q
120 ;
121ERR ;
122 I $ZE'["<NOUCI>" W $ZE,! Q
123 G SUMM
124 ;
Note: See TracBrowser for help on using the repository browser.