ZIBFMD ; IHS/ADC/GTH - DISPLAY FILEMAN INSTALLATION DATA ; [ 10/29/2002 7:42 AM ]
;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
;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
;
ZIBFMD ; IHS/ADC/GTH - DISPLAY FILEMAN INSTALLATION DATA ; [ 10/29/2002 7:42 AM ]
+1 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
+2 ;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
+3 ;
+4 WRITE "Listing of known FileMan Site ID's",!
SETUP ;
+1 DO ^XBKVAR
+2 SET DTIME=300
+3 KILL %,DISYS,%H,X,^TMP("ZIBFMD",$JOB)
+4 SET IOP=$IO
+5 DO ^%ZIS
ZIS ;
+1 KILL ZTSK,IOP,%ZIS
+2 SET %ZIS="PQM"
+3 DO ^%ZIS
+4 IF POP
GOTO EXIT
+5 IF $DATA(IO("Q"))
GOTO QUE
NOQUE ;
+1 IF IO'=IO(0)
WRITE "Printing now ...",!
+2 USE IO
+3 DO EN
+4 DO ^%ZISC
+5 QUIT
+6 ;
QUE ;
+1 KILL ZTSAVE
+2 ; S ZTRTN="EN^ZIBFMD",ZTDESC="FILEMAN ID'S BY UCI",ZTIO=IO,ZTDTH=DT ;IHS/SET/GTH XB*3*9 10/29/2002
+3 ;IHS/SET/GTH XB*3*9 10/29/2002
SET ZTRTN="EN^ZIBFMD"
SET ZTDESC="FILEMAN ID'S BY "_$SELECT($$VERSION^%ZOSV(1)["Cache":"NAMESPACE",1:"UCI")
SET ZTIO=IO
SET ZTDTH=DT
+4 DO ^%ZTLOAD
+5 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+6 QUIT
+7 ;
EN ;EP - From TaskMan. Common processing for tasked or direct mode.
SCAN ;
+1 DO HDR
+2 ; W "Fileman Site IDs by UCI:",! ;IHS/SET/GTH XB*3*9 10/29/2002
+3 ;IHS/SET/GTH XB*3*9 10/29/2002
WRITE "Fileman Site IDs by ",$SELECT($$VERSION^%ZOSV(1)["Cache":"Namespace",1:"UCI"),":",!
+4 SET X="NMUCI^ZIBFMD"
SET @^%ZOSF("TRAP")
+5 ;Begin New Code;IHS/SET/GTH XB*3*9 10/29/2002
+6 IF $$VERSION^%ZOSV(1)["Cache"
Begin DoDot:1
+7 FOR I=1:1:$ZU(90,0)
SET ZIBLIST($ZU(90,2,0,I))=""
+8 SET ZIBFUCI=""
+9 FOR
SET ZIBFUCI=$ORDER(ZIBLIST(ZIBFUCI))
IF ZIBFUCI=""
QUIT
IF "%SYS%CACHELIBSAMPLES"'[ZIBFUCI
DO SHOW
+10 QUIT
End DoDot:1
GOTO NMUCI
+11 ;End New Code;IHS/SET/GTH XB*3*9 10/29/2002
+12 FOR ZIBFI=1:1
SET ZIBFUCI=$ZU(ZIBFI)
IF ZIBFUCI=""
QUIT
IF $PIECE(ZIBFUCI,U,1)'="MGR"
DO SHOW
NMUCI ;
+1 SET X=""
SET @^%ZOSF("TRAP")
DSPLY ;
+1 DO SUMM
DO SHOWF
+2 GOTO EXIT
+3 ;
HDR ;
+1 DO NOW^%DTC
+2 SET Y=%
SET DT=$PIECE(Y,".",1)
+3 IF $DATA(^DD("DD"))
XECUTE ^("DD")
+4 SET ZIBFTDY=$PIECE(Y,":",1,2)
+5 XECUTE ^%ZOSF("UCI")
+6 SET ZIBFHDR(1)="UCI: "_Y_" CPU: "_^%ZOSF("VOL")_" "_ZIBFTDY
SET ZIBFHDR="F i l e M a n I n s t a l l a t i o n D a t a "
+7 WRITE @IOF,!,?IOM-$LENGTH(ZIBFHDR)\2,ZIBFHDR,!,?IOM-$LENGTH(ZIBFHDR(1))\2,ZIBFHDR(1),!!
+8 QUIT
+9 ;
SHOW ;
+1 WRITE ?1,ZIBFUCI,?15
+2 SET X="DDPROT"
SET @^%ZOSF("TRAP")
+3 IF '$DATA(^[ZIBFUCI]DD)
WRITE "--",?50,"No ^DD global!",!
QUIT
+4 ; I '$D(^[ZIBFUCI]DD("SITE")) W "-- No ^DD(""ZIBFSITE"")!",! Q ;IHS/SET/GTH XB*3*9 10/29/2002
+5 ;IHS/SET/GTH XB*3*9 10/29/2002
IF '$DATA(^[ZIBFUCI]DD("SITE"))
WRITE "-- No ^DD(""SITE"")!",!
QUIT
+6 SET ZIBFNAME=^[ZIBFUCI]DD("SITE")
+7 WRITE ZIBFNAME,?50
+8 ; I '$D(^[ZIBFUCI]DD("SITE",1)) W "--",?50,"No ^DD(""ZIBFSITE"",1)!",! Q ;IHS/SET/GTH XB*3*9 10/29/2002
+9 ;IHS/SET/GTH XB*3*9 10/29/2002
IF '$DATA(^[ZIBFUCI]DD("SITE",1))
WRITE "--",?50,"No ^DD(""SITE"",1)!",!
QUIT
+10 SET ZIBFNUM=^[ZIBFUCI]DD("SITE",1)
+11 WRITE ZIBFNUM,!
+12 FOR %=1:1
IF '$DATA(^TMP("ZIBFMD",$JOB,"ID",ZIBFNUM,%))
SET ^(%)=ZIBFUCI_" : "_ZIBFNAME
QUIT
+13 SET ^TMP("ZIBFMD",$JOB,"UCI",ZIBFUCI)=ZIBFNUM
+14 QUIT
+15 ;
DDPROT ;
+1 WRITE "--",?50,"Cannot access ^DD [protection]!",!
+2 QUIT
+3 ;
SUMM ;
+1 WRITE !!,"Summary of known FileMan system ID's:",!
+2 FOR ZIBFI=0:0
SET ZIBFI=$ORDER(^TMP("ZIBFMD",$JOB,"ID",ZIBFI))
IF 'ZIBFI
QUIT
WRITE ?1,$JUSTIFY(ZIBFI,4)
FOR %=1:1
IF '$DATA(^TMP("ZIBFMD",$JOB,"ID",ZIBFI,%))
QUIT
WRITE ?7,^(%),!
+3 QUIT
+4 ;
SHOWF ;
+1 ; W !!,"Listing of locally-developed files by UCI:",! ;IHS/SET/GTH XB*3*9 10/29/2002
+2 ;IHS/SET/GTH XB*3*9 10/29/2002
WRITE !!,"Listing of locally-developed files by ",$SELECT($$VERSION^%ZOSV(1)["Cache":"Namespace",1:"UCI"),":",!
+3 SET ZIBFUCI=""
+4 FOR
SET ZIBFUCI=$ORDER(^TMP("ZIBFMD",$JOB,"UCI",ZIBFUCI))
IF ZIBFUCI=""
QUIT
SET ZIBFNUM=^(ZIBFUCI)
DO SHOWF2
+5 QUIT
+6 ;
SHOWF2 ;
+1 WRITE ?1,ZIBFUCI
+2 SET $ZT="NODIC^ZIBFMD"
SET ZIBFF1=ZIBFNUM*1000
SET ZIBFF2=ZIBFF1+1000
+3 ;I $D(^[ZIBFUCI]DIC(ZIBFF1,0)) D SHOWF3($P(^[ZIBFUCI]DIC(ZIBFF1,0),U)) ;IHS/SET/GTH XB*3*9 10/29/2002
+4 ;IHS/SET/GTH XB*3*9 10/29/2002
IF $DATA(^[ZIBFUCI]DIC(ZIBFF1,0))
DO SHOWF3($PIECE(^[ZIBFUCI]DIC(ZIBFF1,0),U),^[ZIBFUCI]DIC(ZIBFF1,0,"GL"))
+5 ;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
+6 ;IHS/SET/GTH XB*3*9 10/29/2002
FOR
SET ZIBFF1=$ORDER(^[ZIBFUCI]DIC(ZIBFF1))
IF 'ZIBFF1
QUIT
IF ZIBFF1>ZIBFF2
QUIT
DO SHOWF3($PIECE(^[ZIBFUCI]DIC(ZIBFF1,0),U),^[ZIBFUCI]DIC(ZIBFF1,0,"GL"))
+7 IF $X
WRITE !
+8 SET X=""
SET @^%ZOSF("TRAP")
+9 QUIT
+10 ;
NODIC ;
+1 WRITE ?15,"--",?30,"Cannot access ^DIC (protection)",!
+2 QUIT
+3 ;
SHOWF3(X,Y) ;IHS/SET/GTH XB*3*9 10/29/2002 Added parameter "Y".
+1 ;W ?15,ZIBFF1,?30,X,! ;IHS/SET/GTH XB*3*9 10/29/2002
+2 ;IHS/SET/GTH XB*3*9 10/29/2002
WRITE ?15,ZIBFF1,?30,X,?45,Y,!
+3 QUIT
+4 ;
EXIT ;
+1 ;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
+2 ;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",$JOB)
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
+5 ;
ERR ;
+1 IF $ZE'["<NOUCI>"
WRITE $ZE,!
QUIT
+2 GOTO SUMM
+3 ;
