XBHEDD6 ;402,DJB,10/23/91,EDD - Xref,Groups,Pointers In
;;2.6;IHS UTILITIES;;JUN 28, 1993
;; David Bolduc - Togus, ME
XREF ;Cross Reference Listing
I '$D(^DD(ZNUM,0,"IX")) W ?30,"No XREF for this file." S FLAGG=1 Q
S NM="",HD="HD1" D INIT^XBHEDD7 G:FLAGQ EX D HD1
F S NM=$O(^DD(ZNUM,0,"IX",NM)) Q:NM="" D:$Y>SIZE PAGE Q:FLAGQ S ZDD="",ZDD=$O(^DD(ZNUM,0,"IX",NM,ZDD)),ZFLD="",ZFLD=$O(^DD(ZNUM,0,"IX",NM,ZDD,ZFLD)) D XREFPRT
G EX
XREFPRT ;
S GLTEMP=ZGL_""""_NM_""""_")"
W ! W:$D(@(GLTEMP)) ?1,"*" W ?4,"""",NM,"""",?22,$J(ZDD,8),?33,$J(ZFLD,10)
I $D(^DD(ZDD,ZFLD,0)) W ?46,$P(^(0),U) Q
W ?46,"---> Field doesn't exist"
Q
PT ;Pointers to this file
I '$D(^DD(ZNUM,0,"PT")) W ?30,"No files point to this file." S FLAGG=1 Q
D INIT^XBHEDD7 G:FLAGQ EX D HD3 S ZFILE="",ZCNT=1,HD="HD3"
F S ZFILE=$O(^DD(ZNUM,0,"PT",ZFILE)) Q:ZFILE=""!FLAGQ S FLAGPT=0 D @$S($D(^DIC(ZFILE,0)):"PTYES",1:"PTNO") I 'FLAGPT S ZFLD="" F S ZFLD=$O(^DD(ZNUM,0,"PT",ZFILE,ZFLD)) Q:ZFLD="" D PTPRT Q:FLAGQ
G EX
PTNO ;
I '$D(^DD(ZFILE,0,"UP")) S FLAGPT=1 Q
S ZFILETP=ZFILE F S ZFILETP=^DD(ZFILETP,0,"UP") Q:$D(^DIC(ZFILETP,0)) I '$D(^DD(ZFILETP,0,"UP")) Q
I '$D(^DIC(ZFILETP,0)) S FLAGPT=1 Q
S GL=^DIC(ZFILETP,0,"GL"),ZFILEN=$P(^DIC(ZFILETP,0),U)
Q
PTYES ;
S GL=^DIC(ZFILE,0,"GL"),ZFILEN=$P(^DIC(ZFILE,0),U) Q
PTPRT ;
W !,$J(ZCNT,4),".",?6,GL,?21,$E(ZFILEN,1,25)
W ?48 I $D(^DD(ZFILE,ZFLD,0)),$P(^(0),U)]"" W $E($P(^(0),U),1,22)," (",ZFLD,")"
E W "--> Field ",ZFLD," does not exist."
S ZCNT=ZCNT+1 I $Y>SIZE D PAGE Q:FLAGQ
Q
GRP ;Groups
S ZMULT="",HD="HD2" D GRPBLD G:FLAGG EX D INIT^XBHEDD7 G:FLAGQ EX D HD2,GRPPRT
G EX
GRPBLD ;
S Z="",X=1
F S Z=$O(^UTILITY($J,"TMP",Z)) Q:Z="" I $D(^DD(Z,"GR")) S GRP="" F S GRP=$O(^DD(Z,"GR",GRP)) Q:GRP="" S ZFLD="" F S ZFLD=$O(^DD(Z,"GR",GRP,ZFLD)) Q:ZFLD="" S ^UTILITY($J,"GROUP",GRP,Z,ZFLD)=$P(^DD(Z,ZFLD,0),U),X=X+1 I X#9=0 W "."
I '$D(^UTILITY($J,"GROUP")) W ?30,"No Groups established." S FLAGG=1
Q
GRPPRT ;
S GRP="" F I=1:1 S GRP=$O(^UTILITY($J,"GROUP",GRP)) Q:GRP=""!FLAGQ W !,$J(I,3),". ",GRP D GRPPRT1
Q
GRPPRT1 ;
S GRP1=""
F S GRP1=$O(^UTILITY($J,"GROUP",GRP,GRP1)) Q:GRP1=""!FLAGQ S GRP2="" F S GRP2=$O(^UTILITY($J,"GROUP",GRP,GRP1,GRP2)) Q:GRP2="" W ?18,$J(GRP1,6),?27,$J(GRP2,8),?39,^(GRP2),! I $Y>SIZE D PAGE Q:FLAGQ
Q
EX ;
K FLAGPT,GL,GLTEMP,GRP,GRP1,GRP2,HD,NM,ZDD,ZFILE,ZFILEN,ZFILETP,ZFLD,ZGL1,ZMULT
K ^UTILITY($J,"GROUP") Q
HD1 ;XREF
W !?9,"XREF",?25,"DD",?34,"FLD NUM",?56,"FIELD NAME",!?4,"---------------",?22,"--------",?33,"----------",?46,"------------------------------"
Q
HD2 ;Groups
W !?5,"GROUP NAME",?20,"DD",?27,"FLD NUM",?48,"FIELD NAME",!?5,"-----------",?18,"------",?27,"--------",?39,"------------------------------",!
Q
HD3 ;Pointers to this file
W !?3,"Pointers TO this file..",!?9,"GLOBAL",?22,"FILE (Truncated to 25)",?50,"FIELD (Truncated to 22)",!?6,"-------------",?21,"-------------------------",?48,"------------------------------"
Q
PAGE ;
I FLAGP,IO'=IO(0) W @IOF,!!! D @HD Q
R !!?2,"<RETURN> to continue, '^' to quit, '^^' to exit: ",Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
W @IOF D @HD
Q
XBHEDD6 ;402,DJB,10/23/91,EDD - Xref,Groups,Pointers In
+1 ;;2.6;IHS UTILITIES;;JUN 28, 1993
+2 ;; David Bolduc - Togus, ME
XREF ;Cross Reference Listing
+1 IF '$DATA(^DD(ZNUM,0,"IX"))
WRITE ?30,"No XREF for this file."
SET FLAGG=1
QUIT
+2 SET NM=""
SET HD="HD1"
DO INIT^XBHEDD7
IF FLAGQ
GOTO EX
DO HD1
+3 FOR
SET NM=$ORDER(^DD(ZNUM,0,"IX",NM))
IF NM=""
QUIT
IF $Y>SIZE
DO PAGE
IF FLAGQ
QUIT
SET ZDD=""
SET ZDD=$ORDER(^DD(ZNUM,0,"IX",NM,ZDD))
SET ZFLD=""
SET ZFLD=$ORDER(^DD(ZNUM,0,"IX",NM,ZDD,ZFLD))
DO XREFPRT
+4 GOTO EX
XREFPRT ;
+1 SET GLTEMP=ZGL_""""_NM_""""_")"
+2 WRITE !
IF $DATA(@(GLTEMP))
WRITE ?1,"*"
WRITE ?4,"""",NM,"""",?22,$JUSTIFY(ZDD,8),?33,$JUSTIFY(ZFLD,10)
+3 IF $DATA(^DD(ZDD,ZFLD,0))
WRITE ?46,$PIECE(^(0),U)
QUIT
+4 WRITE ?46,"---> Field doesn't exist"
+5 QUIT
PT ;Pointers to this file
+1 IF '$DATA(^DD(ZNUM,0,"PT"))
WRITE ?30,"No files point to this file."
SET FLAGG=1
QUIT
+2 DO INIT^XBHEDD7
IF FLAGQ
GOTO EX
DO HD3
SET ZFILE=""
SET ZCNT=1
SET HD="HD3"
+3 FOR
SET ZFILE=$ORDER(^DD(ZNUM,0,"PT",ZFILE))
IF ZFILE=""!FLAGQ
QUIT
SET FLAGPT=0
DO @$SELECT($DATA(^DIC(ZFILE,0)):"PTYES",1:"PTNO")
IF 'FLAGPT
SET ZFLD=""
FOR
SET ZFLD=$ORDER(^DD(ZNUM,0,"PT",ZFILE,ZFLD))
IF ZFLD=""
QUIT
DO PTPRT
IF FLAGQ
QUIT
+4 GOTO EX
PTNO ;
+1 IF '$DATA(^DD(ZFILE,0,"UP"))
SET FLAGPT=1
QUIT
+2 SET ZFILETP=ZFILE
FOR
SET ZFILETP=^DD(ZFILETP,0,"UP")
IF $DATA(^DIC(ZFILETP,0))
QUIT
IF '$DATA(^DD(ZFILETP,0,"UP"))
QUIT
+3 IF '$DATA(^DIC(ZFILETP,0))
SET FLAGPT=1
QUIT
+4 SET GL=^DIC(ZFILETP,0,"GL")
SET ZFILEN=$PIECE(^DIC(ZFILETP,0),U)
+5 QUIT
PTYES ;
+1 SET GL=^DIC(ZFILE,0,"GL")
SET ZFILEN=$PIECE(^DIC(ZFILE,0),U)
QUIT
PTPRT ;
+1 WRITE !,$JUSTIFY(ZCNT,4),".",?6,GL,?21,$EXTRACT(ZFILEN,1,25)
+2 WRITE ?48
IF $DATA(^DD(ZFILE,ZFLD,0))
IF $PIECE(^(0),U)]""
WRITE $EXTRACT($PIECE(^(0),U),1,22)," (",ZFLD,")"
+3 IF '$TEST
WRITE "--> Field ",ZFLD," does not exist."
+4 SET ZCNT=ZCNT+1
IF $Y>SIZE
DO PAGE
IF FLAGQ
QUIT
+5 QUIT
GRP ;Groups
+1 SET ZMULT=""
SET HD="HD2"
DO GRPBLD
IF FLAGG
GOTO EX
DO INIT^XBHEDD7
IF FLAGQ
GOTO EX
DO HD2
DO GRPPRT
+2 GOTO EX
GRPBLD ;
+1 SET Z=""
SET X=1
+2 FOR
SET Z=$ORDER(^UTILITY($JOB,"TMP",Z))
IF Z=""
QUIT
IF $DATA(^DD(Z,"GR"))
SET GRP=""
FOR
SET GRP=$ORDER(^DD(Z,"GR",GRP))
IF GRP=""
QUIT
SET ZFLD=""
FOR
SET ZFLD=$ORDER(^DD(Z,"GR",GRP,ZFLD))
IF ZFLD=""
QUIT
SET ^UTILITY($JOB,"GROUP",GRP,Z,ZFLD)=$PIECE(^DD(Z,ZFLD,0),U)
SET X=X+1
IF X#9=0
WRITE "."
+3 IF '$DATA(^UTILITY($JOB,"GROUP"))
WRITE ?30,"No Groups established."
SET FLAGG=1
+4 QUIT
GRPPRT ;
+1 SET GRP=""
FOR I=1:1
SET GRP=$ORDER(^UTILITY($JOB,"GROUP",GRP))
IF GRP=""!FLAGQ
QUIT
WRITE !,$JUSTIFY(I,3),". ",GRP
DO GRPPRT1
+2 QUIT
GRPPRT1 ;
+1 SET GRP1=""
+2 FOR
SET GRP1=$ORDER(^UTILITY($JOB,"GROUP",GRP,GRP1))
IF GRP1=""!FLAGQ
QUIT
SET GRP2=""
FOR
SET GRP2=$ORDER(^UTILITY($JOB,"GROUP",GRP,GRP1,GRP2))
IF GRP2=""
QUIT
WRITE ?18,$JUSTIFY(GRP1,6),?27,$JUSTIFY(GRP2,8),?39,^(GRP2),!
IF $Y>SIZE
DO PAGE
IF FLAGQ
QUIT
+3 QUIT
EX ;
+1 KILL FLAGPT,GL,GLTEMP,GRP,GRP1,GRP2,HD,NM,ZDD,ZFILE,ZFILEN,ZFILETP,ZFLD,ZGL1,ZMULT
+2 KILL ^UTILITY($JOB,"GROUP")
QUIT
HD1 ;XREF
+1 WRITE !?9,"XREF",?25,"DD",?34,"FLD NUM",?56,"FIELD NAME",!?4,"---------------",?22,"--------",?33,"----------",?46,"------------------------------"
+2 QUIT
HD2 ;Groups
+1 WRITE !?5,"GROUP NAME",?20,"DD",?27,"FLD NUM",?48,"FIELD NAME",!?5,"-----------",?18,"------",?27,"--------",?39,"------------------------------",!
+2 QUIT
HD3 ;Pointers to this file
+1 WRITE !?3,"Pointers TO this file..",!?9,"GLOBAL",?22,"FILE (Truncated to 25)",?50,"FIELD (Truncated to 22)",!?6,"-------------",?21,"-------------------------",?48,"------------------------------"
+2 QUIT
PAGE ;
+1 IF FLAGP
IF IO'=IO(0)
WRITE @IOF,!!!
DO @HD
QUIT
+2 READ !!?2,"<RETURN> to continue, '^' to quit, '^^' to exit: ",Z1:DTIME
IF '$TEST
SET Z1="^"
IF Z1["^"
SET FLAGQ=1
IF Z1="^^"
SET FLAGE=1
QUIT
+3 WRITE @IOF
DO @HD
+4 QUIT
