- XBHEDD ;402,DJB,5/1/90,EDD - Electronic Data Dictionary
- ;;2.6;IHS UTILITIES;;JUN 28, 1993
- ;;FLAGQ='^',FLAGE='^^',FLAGP=Printing on,FLAGP1=Option 11 selected to turn on printing
- ;;FLAGH=Bypass 1st screen
- ;;FLAGS=Scrolling speed set,FLAGL=Last item in list,FLAGM='^' or
- ;;'^^' in menu,FLAGG=No Groups,FLAGNFF=Suppress Form Feed,FLAGPT=Pointer File or Field nonexistent
- ;;FLAGGL=Invalid entry in GLOBAL
- TOP ;
- S:'$D(DUZ)#2 DUZ=0 I +DUZ=0 W *7,!!?5,"Your DUZ is not defined!",! Q
- N FLAGE,FLAGG,FLAGGL,FLAGGL1,FLAGL,FLAGM,FLAGP,FLAGP1,FLAGQ,FLAGS
- N A,B,BAR,C,C1,DASHES,DIC,E,EDDDATE,FGRP,FILE,FLD,G,GROUP,GROUP1,GRP1,GRP2,GT,H,HD,I,I2,II,III,IOP,J,K,L,LENGTH,LEVEL,LINE,M1,M2,M3,M4,M5,NORMAL,NUM,O,PAGE,SCROLL,SIZE,SLOW,SPACE,STRING,X,XREF,XREFNAM,XREFTYPE,XX,Y,YCNT
- N Z,Z1,ZA,ZANS,ZAP,ZB,ZCNT,ZD,ZDATA,ZDATA1,ZDSUB,ZFLDNAM,ZFLDNUM,ZGL,ZGL1,ZHELP,ZHNUM,ZLINE,ZLINE1,ZLINE2,ZMULT,ZMZ,ZNAM,ZPOTMP,ZZGL
- N ZNUM,ZONE,ZPAGE,ZPF,ZPO,ZPO1,ZPO2,ZTHREE,ZTWO,ZX,ZY1,ZZ,ZZ1,ZZA,ZZB,ZZH,ZZX
- D INIT
- EN S (FLAGP,FLAGQ,FLAGS)=0 K ^UTILITY($J)
- D:'FLAGH HD
- D GETFILE G:FLAGQ EX D MULT^XBHEDD7,MENU G:FLAGE EX
- S FLAGH=1 G EN ;Set FLAGH to bypass opening screen
- EX ;Exit
- K FLAGH,FLAGNFF,^UTILITY($J)
- Q
- GETFILE ;File lookup
- R !?8,"Select FILE: ",X:DTIME S:'$T X="^" I "^"[X S FLAGQ=1 Q
- I $L(X)>1,$E(X)="^" D GLOBAL^XBHEDD9 G:FLAGGL GETFILE Q
- I X="?" W !?1,"Enter global in the format '^DG' or '^RA(78', or"
- S DIC="^DIC(",DIC(0)="QEM" D ^DIC K DIC I Y<0 G GETFILE
- S ZNUM=+Y,ZNAM=$P(Y,U,2),ZGL=^DIC(ZNUM,0,"GL")
- Q
- S (FLAGE,FLAGG,FLAGL,FLAGM,FLAGQ,FLAGP1,FLAGS)=0
- D HD1,^XBHEDDM G:FLAGP1 MENU I FLAGP S:IO'=IO(0) FLAGQ=1 D PRINT^XBHEDD7 ;Turn off printing
- Q:FLAGM!FLAGE G:FLAGQ MENU
- I $Y'>SIZE F I=$Y:1:SIZE W !
- R !!?2,"<RETURN> to go to Main Menu, '^' to exit: ",Z1:DTIME S:'$T Z1="^" I Z1="^" S FLAGE=1 Q
- G MENU
- DIR ;Supress heading
- S FLAGH=1 G TOP
- GL ;Call XBHEDD here to get listing of Globals in ASCII order.
- N FLAGH,FLAGNFF,FLAGP,FLAGQ,M1,M2,M3,M4,M5,SIZE,Z1,ZLINE,ZLINE1,ZLINE2
- S SIZE=(IOSL-5),(FLAGP,FLAGQ)=0 D INIT,GL^XBHEDD10 G EX
- PRT ;Stop page feeds. Use on ptr/keyboard
- S (FLAGH,FLAGNFF)=1 G TOP
- HD ;
- W:'FLAGNFF @IOF
- W !?65,"David Bolduc",!?65,"Togus, ME"
- W !!!?35,"E D D",!?34,"~~~~~~~",!?35,"~~~~~",!?36,"~~~",!?37,"~",!?25,"Electronic Data Dictionary",!?32,"Version 2.3",!
- W !?22,"*",?25,"Everything you ever wanted",?53,"*",!?22,"*",?25,"to know about a file but",?53,"*",!?22,"*",?25,"were afraid to ask.",?53,"*"
- W !!
- Q
- HD1 ;Heading for Top of Main Menu
- W:'FLAGNFF @IOF W !?M1,"A.) FILE NAME:------------- ",ZNAM
- W !?48,"F.) FILE ACCESS:"
- W !?M1,"B.) FILE NUMBER:----------- ",ZNUM
- W ?53,"DD______ ",$S($D(^DIC(ZNUM,0,"DD")):^("DD"),1:"")
- W !?53,"Read____ ",$S($D(^DIC(ZNUM,0,"RD")):^("RD"),1:"")
- W !?M1,"C.) NUM OF FLDS:----------- ",^UTILITY($J,"TOT")
- W ?53,"Write___ ",$S($D(^DIC(ZNUM,0,"WR")):^("WR"),1:"")
- W !?53,"Delete__ ",$S($D(^DIC(ZNUM,0,"DEL")):^("DEL"),1:"")
- W !?M1,"D.) DATA GLOBAL:----------- ",ZGL
- W ?53,"Laygo___ ",$S($D(^DIC(ZNUM,0,"LAYGO")):^("LAYGO"),1:"")
- W !!?M1,"E.) TOTAL GLOBAL ENTRIES:-- "
- S ZZGL=ZGL_"0)",ZZGL=@ZZGL W $S($P(ZZGL,U,4)]"":$P(ZZGL,U,4),1:"Blank")
- W ?48,"G.) PRINTING STATUS:-- ",$S(FLAGP:"On",1:"Off")
- W !,$E(ZLINE1,1,80)
- Q
- INIT ;
- S:'$D(DTIME) DTIME=600 S M1=2,M2=15,M3=20,M4=22,M5=25 ;Variables for column numbers
- K ZLINE,ZLINE1,ZLINE2 S $P(ZLINE,"-",212)="",$P(ZLINE1,"=",212)="",$P(ZLINE2,". ",106)="",U="^"
- S IOP=0 D ^%ZIS K IOP S SIZE=(IOSL-5) S:'$D(FLAGNFF) FLAGNFF=0 S:'$D(FLAGH) FLAGH=0
- Q
- XBHEDD ;402,DJB,5/1/90,EDD - Electronic Data Dictionary
- +1 ;;2.6;IHS UTILITIES;;JUN 28, 1993
- +2 ;;FLAGQ='^',FLAGE='^^',FLAGP=Printing on,FLAGP1=Option 11 selected to turn on printing
- +3 ;;FLAGH=Bypass 1st screen
- +4 ;;FLAGS=Scrolling speed set,FLAGL=Last item in list,FLAGM='^' or
- +5 ;;'^^' in menu,FLAGG=No Groups,FLAGNFF=Suppress Form Feed,FLAGPT=Pointer File or Field nonexistent
- +6 ;;FLAGGL=Invalid entry in GLOBAL
- TOP ;
- +1 IF '$DATA(DUZ)#2
- SET DUZ=0
- IF +DUZ=0
- WRITE *7,!!?5,"Your DUZ is not defined!",!
- QUIT
- +2 NEW FLAGE,FLAGG,FLAGGL,FLAGGL1,FLAGL,FLAGM,FLAGP,FLAGP1,FLAGQ,FLAGS
- +3 NEW A,B,BAR,C,C1,DASHES,DIC,E,EDDDATE,FGRP,FILE,FLD,G,GROUP,GROUP1,GRP1,GRP2,GT,H,HD,I,I2,II,III,IOP,J,K,L,LENGTH,LEVEL,LINE,M1,M2,M3,M4,M5,NORMAL,NUM,O,PAGE,SCROLL,SIZE,SLOW,SPACE,STRING,X,XREF,XREFNAM,XREFTYPE,XX,Y,YCNT
- +4 NEW Z,Z1,ZA,ZANS,ZAP,ZB,ZCNT,ZD,ZDATA,ZDATA1,ZDSUB,ZFLDNAM,ZFLDNUM,ZGL,ZGL1,ZHELP,ZHNUM,ZLINE,ZLINE1,ZLINE2,ZMULT,ZMZ,ZNAM,ZPOTMP,ZZGL
- +5 NEW ZNUM,ZONE,ZPAGE,ZPF,ZPO,ZPO1,ZPO2,ZTHREE,ZTWO,ZX,ZY1,ZZ,ZZ1,ZZA,ZZB,ZZH,ZZX
- +6 DO INIT
- EN SET (FLAGP,FLAGQ,FLAGS)=0
- KILL ^UTILITY($JOB)
- +1 IF 'FLAGH
- DO HD
- +2 DO GETFILE
- IF FLAGQ
- GOTO EX
- DO MULT^XBHEDD7
- DO MENU
- IF FLAGE
- GOTO EX
- +3 ;Set FLAGH to bypass opening screen
- SET FLAGH=1
- GOTO EN
- EX ;Exit
- +1 KILL FLAGH,FLAGNFF,^UTILITY($JOB)
- +2 QUIT
- GETFILE ;File lookup
- +1 READ !?8,"Select FILE: ",X:DTIME
- IF '$TEST
- SET X="^"
- IF "^"[X
- SET FLAGQ=1
- QUIT
- +2 IF $LENGTH(X)>1
- IF $EXTRACT(X)="^"
- DO GLOBAL^XBHEDD9
- IF FLAGGL
- GOTO GETFILE
- QUIT
- +3 IF X="?"
- WRITE !?1,"Enter global in the format '^DG' or '^RA(78', or"
- +4 SET DIC="^DIC("
- SET DIC(0)="QEM"
- DO ^DIC
- KILL DIC
- IF Y<0
- GOTO GETFILE
- +5 SET ZNUM=+Y
- SET ZNAM=$PIECE(Y,U,2)
- SET ZGL=^DIC(ZNUM,0,"GL")
- +6 QUIT
- +1 SET (FLAGE,FLAGG,FLAGL,FLAGM,FLAGQ,FLAGP1,FLAGS)=0
- +2 ;Turn off printing
- DO HD1
- DO ^XBHEDDM
- IF FLAGP1
- GOTO MENU
- IF FLAGP
- IF IO'=IO(0)
- SET FLAGQ=1
- DO PRINT^XBHEDD7
- +3 IF FLAGM!FLAGE
- QUIT
- IF FLAGQ
- GOTO MENU
- +4 IF $Y'>SIZE
- FOR I=$Y:1:SIZE
- WRITE !
- +5 READ !!?2,"<RETURN> to go to Main Menu, '^' to exit: ",Z1:DTIME
- IF '$TEST
- SET Z1="^"
- IF Z1="^"
- SET FLAGE=1
- QUIT
- +6 GOTO MENU
- DIR ;Supress heading
- +1 SET FLAGH=1
- GOTO TOP
- GL ;Call XBHEDD here to get listing of Globals in ASCII order.
- +1 NEW FLAGH,FLAGNFF,FLAGP,FLAGQ,M1,M2,M3,M4,M5,SIZE,Z1,ZLINE,ZLINE1,ZLINE2
- +2 SET SIZE=(IOSL-5)
- SET (FLAGP,FLAGQ)=0
- DO INIT
- DO GL^XBHEDD10
- GOTO EX
- PRT ;Stop page feeds. Use on ptr/keyboard
- +1 SET (FLAGH,FLAGNFF)=1
- GOTO TOP
- HD ;
- +1 IF 'FLAGNFF
- WRITE @IOF
- +2 WRITE !?65,"David Bolduc",!?65,"Togus, ME"
- +3 WRITE !!!?35,"E D D",!?34,"~~~~~~~",!?35,"~~~~~",!?36,"~~~",!?37,"~",!?25,"Electronic Data Dictionary",!?32,"Version 2.3",!
- +4 WRITE !?22,"*",?25,"Everything you ever wanted",?53,"*",!?22,"*",?25,"to know about a file but",?53,"*",!?22,"*",?25,"were afraid to ask.",?53,"*"
- +5 WRITE !!
- +6 QUIT
- HD1 ;Heading for Top of Main Menu
- +1 IF 'FLAGNFF
- WRITE @IOF
- WRITE !?M1,"A.) FILE NAME:------------- ",ZNAM
- +2 WRITE !?48,"F.) FILE ACCESS:"
- +3 WRITE !?M1,"B.) FILE NUMBER:----------- ",ZNUM
- +4 WRITE ?53,"DD______ ",$SELECT($DATA(^DIC(ZNUM,0,"DD")):^("DD"),1:"")
- +5 WRITE !?53,"Read____ ",$SELECT($DATA(^DIC(ZNUM,0,"RD")):^("RD"),1:"")
- +6 WRITE !?M1,"C.) NUM OF FLDS:----------- ",^UTILITY($JOB,"TOT")
- +7 WRITE ?53,"Write___ ",$SELECT($DATA(^DIC(ZNUM,0,"WR")):^("WR"),1:"")
- +8 WRITE !?53,"Delete__ ",$SELECT($DATA(^DIC(ZNUM,0,"DEL")):^("DEL"),1:"")
- +9 WRITE !?M1,"D.) DATA GLOBAL:----------- ",ZGL
- +10 WRITE ?53,"Laygo___ ",$SELECT($DATA(^DIC(ZNUM,0,"LAYGO")):^("LAYGO"),1:"")
- +11 WRITE !!?M1,"E.) TOTAL GLOBAL ENTRIES:-- "
- +12 SET ZZGL=ZGL_"0)"
- SET ZZGL=@ZZGL
- WRITE $SELECT($PIECE(ZZGL,U,4)]"":$PIECE(ZZGL,U,4),1:"Blank")
- +13 WRITE ?48,"G.) PRINTING STATUS:-- ",$SELECT(FLAGP:"On",1:"Off")
- +14 WRITE !,$EXTRACT(ZLINE1,1,80)
- +15 QUIT
- INIT ;
- +1 ;Variables for column numbers
- IF '$DATA(DTIME)
- SET DTIME=600
- SET M1=2
- SET M2=15
- SET M3=20
- SET M4=22
- SET M5=25
- +2 KILL ZLINE,ZLINE1,ZLINE2
- SET $PIECE(ZLINE,"-",212)=""
- SET $PIECE(ZLINE1,"=",212)=""
- SET $PIECE(ZLINE2,". ",106)=""
- SET U="^"
- +3 SET IOP=0
- DO ^%ZIS
- KILL IOP
- SET SIZE=(IOSL-5)
- IF '$DATA(FLAGNFF)
- SET FLAGNFF=0
- IF '$DATA(FLAGH)
- SET FLAGH=0
- +4 QUIT
