- XBHEDD1 ;402,DJB,10/23/91,EDD - FIELD Global Locations
- ;;2.6;IHS UTILITIES;;JUN 28, 1993
- ;;David Bolduc - Togus, ME
- PRINT ;Called by START,LOOP
- Q:'$D(^DD(FILE(LEVEL),FLD(LEVEL),0))
- S ZDATA=^DD(FILE(LEVEL),FLD(LEVEL),0),ZZA=$S($P(ZDATA,U,4)=" ; ":"Computed",1:$P(ZDATA,U,4)),ZZB=$P(ZDATA,U)
- W !?2,$J(ZZA,12),?17,$J(FLD(LEVEL),8),?28,DASHES,ZZB
- S ZY1=$P($P(ZDATA,U,4),";",2) W:ZY1=0 ?70,"-->Mult"
- S ZMZ=" " I ZY1=0 F II=1:1:41-$L(DASHES_ZZB) S ZMZ=ZMZ_" "
- I S ZMZ=ZMZ_"-->Mult"
- I 'FLAGP S ^UTILITY($J,"LIST",PAGE,YCNT)=ZZA_"^"_FLD(LEVEL)_"^"_DASHES_ZZB_ZMZ
- S YCNT=YCNT+1
- Q
- EN ;Entry Point
- D ASK G:FLAGQ EX
- I FLAGP,IO'=IO(0),^UTILITY($J,"TOT")>100 D WARN G:FLAGQ EX
- S HD="HD" D INIT^XBHEDD7 G:FLAGQ EX D @HD D START,LOOP
- EX ;
- I FLAGQ!FLAGE!FLAGP S:IO'=IO(0) FLAGQ=1 D KILL Q
- S FLAGL=1 D ^XBHEDD2 S:'FLAGQ FLAGQ=1 D KILL
- Q
- ASK ;
- W !?26,"""F""........ to select starting FIELD",!?26,"<RETURN>... for all fields"
- ASK1 W !?30,"Select: ALL// " R ZZX:DTIME S:'$T ZZX="^" I ZZX["^" S FLAGQ=1 S:ZZX="^^" FLAGE=1 Q
- I ZZX="?" W !?10,"Type ""^"" to quit",!?10,"<RETURN> to see all fields",!?10,"""F"" to start listing at a particular field" G ASK1
- S (LEVEL,PAGE,YCNT)=1,FILE(LEVEL)=ZNUM,DASHES=""
- I ZZX="F" W ! S DIC="^DD("_ZNUM_",",DIC(0)="QEAM",DIC("W")="I $P(^DD(ZNUM,Y,0),U,2)>0 W ?65,"" -->Mult""" D ^DIC K DIC("W") S:Y<0 FLAGQ=1 Q:Y<0 S FLD(LEVEL)=+Y
- E S FLD(LEVEL)=0
- Q
- START ;Print if data, otherwise continue to loop.
- I $D(^DD(FILE(LEVEL),FLD(LEVEL),0))#2 D PRINT I ZY1=0 S LEVEL=LEVEL+1,FILE(LEVEL)=+$P(ZDATA,U,2),FLD(LEVEL)=0
- Q
- LOOP ;Start For Loop
- S FLD(LEVEL)=$O(^DD(FILE(LEVEL),FLD(LEVEL))) I +FLD(LEVEL)=0 S LEVEL=LEVEL-1 G:LEVEL LOOP Q
- S (SPACE,BAR)=""
- F II=1:1:LEVEL-1 S SPACE=SPACE_" ",BAR=BAR_"-"
- S DASHES=SPACE_BAR
- D PRINT I ZY1=0 S LEVEL=LEVEL+1,FILE(LEVEL)=+$P(ZDATA,U,2),FLD(LEVEL)=0
- I $Y>SIZE D:'FLAGP ^XBHEDD2 Q:FLAGQ I FLAGP D PAUSE Q:FLAGQ W @IOF W:IO'=IO(0) !!! D HD
- G LOOP
- PAUSE ;
- Q:IO'=IO(0)
- W !!?2,"<RETURN> to continue, '^' to quit: "
- R Z1:DTIME S:'$T Z1="^^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1
- Q
- WARN ;Warn if printing and over 100 fields in file
- W !?8,"This file has over 100 fields. Sure you want to print? YES//"
- R XX:DTIME S:'$T XX="N" S:"Yy"'[$E(XX) FLAGQ=1 I XX="?" W !?2,"[Y]es to print, [N]o to return to Main Menu." G WARN
- Q
- HD ;
- W !?2,"NODE ; PIECE",?17,"FLD NUM",?48,"FIELD NAME",!?2,"------------",?17,"--------",?28,"-------------------------------------------------"
- Q
- KILL ;Kill variables
- K DASHES,EDDDATE,FILE,HD,LEVEL,PAGE,PAGETEMP,YCNT,^UTILITY($J,"LIST")
- Q
- XBHEDD1 ;402,DJB,10/23/91,EDD - FIELD Global Locations
- +1 ;;2.6;IHS UTILITIES;;JUN 28, 1993
- +2 ;;David Bolduc - Togus, ME
- PRINT ;Called by START,LOOP
- +1 IF '$DATA(^DD(FILE(LEVEL),FLD(LEVEL),0))
- QUIT
- +2 SET ZDATA=^DD(FILE(LEVEL),FLD(LEVEL),0)
- SET ZZA=$SELECT($PIECE(ZDATA,U,4)=" ; ":"Computed",1:$PIECE(ZDATA,U,4))
- SET ZZB=$PIECE(ZDATA,U)
- +3 WRITE !?2,$JUSTIFY(ZZA,12),?17,$JUSTIFY(FLD(LEVEL),8),?28,DASHES,ZZB
- +4 SET ZY1=$PIECE($PIECE(ZDATA,U,4),";",2)
- IF ZY1=0
- WRITE ?70,"-->Mult"
- +5 SET ZMZ=" "
- IF ZY1=0
- FOR II=1:1:41-$LENGTH(DASHES_ZZB)
- SET ZMZ=ZMZ_" "
- +6 IF $TEST
- SET ZMZ=ZMZ_"-->Mult"
- +7 IF 'FLAGP
- SET ^UTILITY($JOB,"LIST",PAGE,YCNT)=ZZA_"^"_FLD(LEVEL)_"^"_DASHES_ZZB_ZMZ
- +8 SET YCNT=YCNT+1
- +9 QUIT
- EN ;Entry Point
- +1 DO ASK
- IF FLAGQ
- GOTO EX
- +2 IF FLAGP
- IF IO'=IO(0)
- IF ^UTILITY($JOB,"TOT")>100
- DO WARN
- IF FLAGQ
- GOTO EX
- +3 SET HD="HD"
- DO INIT^XBHEDD7
- IF FLAGQ
- GOTO EX
- DO @HD
- DO START
- DO LOOP
- EX ;
- +1 IF FLAGQ!FLAGE!FLAGP
- IF IO'=IO(0)
- SET FLAGQ=1
- DO KILL
- QUIT
- +2 SET FLAGL=1
- DO ^XBHEDD2
- IF 'FLAGQ
- SET FLAGQ=1
- DO KILL
- +3 QUIT
- ASK ;
- +1 WRITE !?26,"""F""........ to select starting FIELD",!?26,"<RETURN>... for all fields"
- ASK1 WRITE !?30,"Select: ALL// "
- READ ZZX:DTIME
- IF '$TEST
- SET ZZX="^"
- IF ZZX["^"
- SET FLAGQ=1
- IF ZZX="^^"
- SET FLAGE=1
- QUIT
- +1 IF ZZX="?"
- WRITE !?10,"Type ""^"" to quit",!?10,"<RETURN> to see all fields",!?10,"""F"" to start listing at a particular field"
- GOTO ASK1
- +2 SET (LEVEL,PAGE,YCNT)=1
- SET FILE(LEVEL)=ZNUM
- SET DASHES=""
- +3 IF ZZX="F"
- WRITE !
- SET DIC="^DD("_ZNUM_","
- SET DIC(0)="QEAM"
- SET DIC("W")="I $P(^DD(ZNUM,Y,0),U,2)>0 W ?65,"" -->Mult"""
- DO ^DIC
- KILL DIC("W")
- IF Y<0
- SET FLAGQ=1
- IF Y<0
- QUIT
- SET FLD(LEVEL)=+Y
- +4 IF '$TEST
- SET FLD(LEVEL)=0
- +5 QUIT
- START ;Print if data, otherwise continue to loop.
- +1 IF $DATA(^DD(FILE(LEVEL),FLD(LEVEL),0))#2
- DO PRINT
- IF ZY1=0
- SET LEVEL=LEVEL+1
- SET FILE(LEVEL)=+$PIECE(ZDATA,U,2)
- SET FLD(LEVEL)=0
- +2 QUIT
- LOOP ;Start For Loop
- +1 SET FLD(LEVEL)=$ORDER(^DD(FILE(LEVEL),FLD(LEVEL)))
- IF +FLD(LEVEL)=0
- SET LEVEL=LEVEL-1
- IF LEVEL
- GOTO LOOP
- QUIT
- +2 SET (SPACE,BAR)=""
- +3 FOR II=1:1:LEVEL-1
- SET SPACE=SPACE_" "
- SET BAR=BAR_"-"
- +4 SET DASHES=SPACE_BAR
- +5 DO PRINT
- IF ZY1=0
- SET LEVEL=LEVEL+1
- SET FILE(LEVEL)=+$PIECE(ZDATA,U,2)
- SET FLD(LEVEL)=0
- +6 IF $Y>SIZE
- IF 'FLAGP
- DO ^XBHEDD2
- IF FLAGQ
- QUIT
- IF FLAGP
- DO PAUSE
- IF FLAGQ
- QUIT
- WRITE @IOF
- IF IO'=IO(0)
- WRITE !!!
- DO HD
- +7 GOTO LOOP
- PAUSE ;
- +1 IF IO'=IO(0)
- QUIT
- +2 WRITE !!?2,"<RETURN> to continue, '^' to quit: "
- +3 READ Z1:DTIME
- IF '$TEST
- SET Z1="^^"
- IF Z1["^"
- SET FLAGQ=1
- IF Z1="^^"
- SET FLAGE=1
- +4 QUIT
- WARN ;Warn if printing and over 100 fields in file
- +1 WRITE !?8,"This file has over 100 fields. Sure you want to print? YES//"
- +2 READ XX:DTIME
- IF '$TEST
- SET XX="N"
- IF "Yy"'[$EXTRACT(XX)
- SET FLAGQ=1
- IF XX="?"
- WRITE !?2,"[Y]es to print, [N]o to return to Main Menu."
- GOTO WARN
- +3 QUIT
- HD ;
- +1 WRITE !?2,"NODE ; PIECE",?17,"FLD NUM",?48,"FIELD NAME",!?2,"------------",?17,"--------",?28,"-------------------------------------------------"
- +2 QUIT
- KILL ;Kill variables
- +1 KILL DASHES,EDDDATE,FILE,HD,LEVEL,PAGE,PAGETEMP,YCNT,^UTILITY($JOB,"LIST")
- +2 QUIT
