VistA-IHS-VA_UTILITIES-XB/ZIBFMD.m

125 lines
4.3 KiB
Mathematica

ZIBFMD ; IHS/ADC/GTH - DISPLAY FILEMAN INSTALLATION DATA ; [ 10/29/2002 7:42 AM ]
;;4.0;XB;;Jul 20, 2009;Build 2
;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
;
W "Listing of known FileMan Site ID's",!
SETUP ;
D ^XBKVAR
S DTIME=300
KILL %,DISYS,%H,X,^TMP("ZIBFMD",$J)
S IOP=$I
D ^%ZIS
ZIS ;
KILL ZTSK,IOP,%ZIS
S %ZIS="PQM"
D ^%ZIS
G:POP EXIT
G:$D(IO("Q")) QUE
NOQUE ;
I IO'=IO(0) W "Printing now ...",!
U IO
D EN
D ^%ZISC
Q
;
QUE ;
KILL ZTSAVE
; S ZTRTN="EN^ZIBFMD",ZTDESC="FILEMAN ID'S BY UCI",ZTIO=IO,ZTDTH=DT ;IHS/SET/GTH XB*3*9 10/29/2002
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
D ^%ZTLOAD
KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
;
EN ;EP - From TaskMan. Common processing for tasked or direct mode.
SCAN ;
D HDR
; W "Fileman Site IDs by UCI:",! ;IHS/SET/GTH XB*3*9 10/29/2002
W "Fileman Site IDs by ",$S($$VERSION^%ZOSV(1)["Cache":"Namespace",1:"UCI"),":",! ;IHS/SET/GTH XB*3*9 10/29/2002
S X="NMUCI^ZIBFMD",@^%ZOSF("TRAP")
;Begin New Code;IHS/SET/GTH XB*3*9 10/29/2002
I $$VERSION^%ZOSV(1)["Cache" D G NMUCI
. F I=1:1:$ZU(90,0) S ZIBLIST($ZU(90,2,0,I))=""
. S ZIBFUCI=""
. F S ZIBFUCI=$O(ZIBLIST(ZIBFUCI)) Q:ZIBFUCI="" D:"%SYS%CACHELIBSAMPLES"'[ZIBFUCI SHOW
.Q
;End New Code;IHS/SET/GTH XB*3*9 10/29/2002
F ZIBFI=1:1 S ZIBFUCI=$ZU(ZIBFI) Q:ZIBFUCI="" D:$P(ZIBFUCI,U,1)'="MGR" SHOW
NMUCI ;
S X="",@^%ZOSF("TRAP")
DSPLY ;
D SUMM,SHOWF
G EXIT
;
HDR ;
D NOW^%DTC
S Y=%,DT=$P(Y,".",1)
X:$D(^DD("DD")) ^("DD")
S ZIBFTDY=$P(Y,":",1,2)
X ^%ZOSF("UCI")
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 "
W @IOF,!,?IOM-$L(ZIBFHDR)\2,ZIBFHDR,!,?IOM-$L(ZIBFHDR(1))\2,ZIBFHDR(1),!!
Q
;
SHOW ;
W ?1,ZIBFUCI,?15
S X="DDPROT",@^%ZOSF("TRAP")
I '$D(^[ZIBFUCI]DD) W "--",?50,"No ^DD global!",! Q
; I '$D(^[ZIBFUCI]DD("SITE")) W "-- No ^DD(""ZIBFSITE"")!",! Q ;IHS/SET/GTH XB*3*9 10/29/2002
I '$D(^[ZIBFUCI]DD("SITE")) W "-- No ^DD(""SITE"")!",! Q ;IHS/SET/GTH XB*3*9 10/29/2002
S ZIBFNAME=^[ZIBFUCI]DD("SITE")
W ZIBFNAME,?50
; I '$D(^[ZIBFUCI]DD("SITE",1)) W "--",?50,"No ^DD(""ZIBFSITE"",1)!",! Q ;IHS/SET/GTH XB*3*9 10/29/2002
I '$D(^[ZIBFUCI]DD("SITE",1)) W "--",?50,"No ^DD(""SITE"",1)!",! Q ;IHS/SET/GTH XB*3*9 10/29/2002
S ZIBFNUM=^[ZIBFUCI]DD("SITE",1)
W ZIBFNUM,!
F %=1:1 I '$D(^TMP("ZIBFMD",$J,"ID",ZIBFNUM,%)) S ^(%)=ZIBFUCI_" : "_ZIBFNAME Q
S ^TMP("ZIBFMD",$J,"UCI",ZIBFUCI)=ZIBFNUM
Q
;
DDPROT ;
W "--",?50,"Cannot access ^DD [protection]!",!
Q
;
SUMM ;
W !!,"Summary of known FileMan system ID's:",!
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,^(%),!
Q
;
SHOWF ;
; W !!,"Listing of locally-developed files by UCI:",! ;IHS/SET/GTH XB*3*9 10/29/2002
W !!,"Listing of locally-developed files by ",$S($$VERSION^%ZOSV(1)["Cache":"Namespace",1:"UCI"),":",! ;IHS/SET/GTH XB*3*9 10/29/2002
S ZIBFUCI=""
F S ZIBFUCI=$O(^TMP("ZIBFMD",$J,"UCI",ZIBFUCI)) Q:ZIBFUCI="" S ZIBFNUM=^(ZIBFUCI) D SHOWF2
Q
;
SHOWF2 ;
W ?1,ZIBFUCI
S $ZT="NODIC^ZIBFMD",ZIBFF1=ZIBFNUM*1000,ZIBFF2=ZIBFF1+1000
;I $D(^[ZIBFUCI]DIC(ZIBFF1,0)) D SHOWF3($P(^[ZIBFUCI]DIC(ZIBFF1,0),U)) ;IHS/SET/GTH XB*3*9 10/29/2002
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
;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
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
W:$X !
S X="",@^%ZOSF("TRAP")
Q
;
NODIC ;
W ?15,"--",?30,"Cannot access ^DIC (protection)",!
Q
;
SHOWF3(X,Y) ;IHS/SET/GTH XB*3*9 10/29/2002 Added parameter "Y".
;W ?15,ZIBFF1,?30,X,! ;IHS/SET/GTH XB*3*9 10/29/2002
W ?15,ZIBFF1,?30,X,?45,Y,! ;IHS/SET/GTH XB*3*9 10/29/2002
Q
;
EXIT ;
;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
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
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
ERR ;
I $ZE'["<NOUCI>" W $ZE,! Q
G SUMM
;