- 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
