| 1 | XBHEDD1 ;402,DJB,10/23/91,EDD - FIELD Global Locations
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;;David Bolduc - Togus, ME
|
|---|
| 4 | PRINT ;Called by START,LOOP
|
|---|
| 5 | Q:'$D(^DD(FILE(LEVEL),FLD(LEVEL),0))
|
|---|
| 6 | S ZDATA=^DD(FILE(LEVEL),FLD(LEVEL),0),ZZA=$S($P(ZDATA,U,4)=" ; ":"Computed",1:$P(ZDATA,U,4)),ZZB=$P(ZDATA,U)
|
|---|
| 7 | W !?2,$J(ZZA,12),?17,$J(FLD(LEVEL),8),?28,DASHES,ZZB
|
|---|
| 8 | S ZY1=$P($P(ZDATA,U,4),";",2) W:ZY1=0 ?70,"-->Mult"
|
|---|
| 9 | S ZMZ=" " I ZY1=0 F II=1:1:41-$L(DASHES_ZZB) S ZMZ=ZMZ_" "
|
|---|
| 10 | I S ZMZ=ZMZ_"-->Mult"
|
|---|
| 11 | I 'FLAGP S ^UTILITY($J,"LIST",PAGE,YCNT)=ZZA_"^"_FLD(LEVEL)_"^"_DASHES_ZZB_ZMZ
|
|---|
| 12 | S YCNT=YCNT+1
|
|---|
| 13 | Q
|
|---|
| 14 | EN ;Entry Point
|
|---|
| 15 | D ASK G:FLAGQ EX
|
|---|
| 16 | I FLAGP,IO'=IO(0),^UTILITY($J,"TOT")>100 D WARN G:FLAGQ EX
|
|---|
| 17 | S HD="HD" D INIT^XBHEDD7 G:FLAGQ EX D @HD D START,LOOP
|
|---|
| 18 | EX ;
|
|---|
| 19 | I FLAGQ!FLAGE!FLAGP S:IO'=IO(0) FLAGQ=1 D KILL Q
|
|---|
| 20 | S FLAGL=1 D ^XBHEDD2 S:'FLAGQ FLAGQ=1 D KILL
|
|---|
| 21 | Q
|
|---|
| 22 | ASK ;
|
|---|
| 23 | W !?26,"""F""........ to select starting FIELD",!?26,"<RETURN>... for all fields"
|
|---|
| 24 | ASK1 W !?30,"Select: ALL// " R ZZX:DTIME S:'$T ZZX="^" I ZZX["^" S FLAGQ=1 S:ZZX="^^" FLAGE=1 Q
|
|---|
| 25 | I ZZX="?" W !?10,"Type ""^"" to quit",!?10,"<RETURN> to see all fields",!?10,"""F"" to start listing at a particular field" G ASK1
|
|---|
| 26 | S (LEVEL,PAGE,YCNT)=1,FILE(LEVEL)=ZNUM,DASHES=""
|
|---|
| 27 | 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
|
|---|
| 28 | E S FLD(LEVEL)=0
|
|---|
| 29 | Q
|
|---|
| 30 | START ;Print if data, otherwise continue to loop.
|
|---|
| 31 | 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
|
|---|
| 32 | Q
|
|---|
| 33 | LOOP ;Start For Loop
|
|---|
| 34 | S FLD(LEVEL)=$O(^DD(FILE(LEVEL),FLD(LEVEL))) I +FLD(LEVEL)=0 S LEVEL=LEVEL-1 G:LEVEL LOOP Q
|
|---|
| 35 | S (SPACE,BAR)=""
|
|---|
| 36 | F II=1:1:LEVEL-1 S SPACE=SPACE_" ",BAR=BAR_"-"
|
|---|
| 37 | S DASHES=SPACE_BAR
|
|---|
| 38 | D PRINT I ZY1=0 S LEVEL=LEVEL+1,FILE(LEVEL)=+$P(ZDATA,U,2),FLD(LEVEL)=0
|
|---|
| 39 | I $Y>SIZE D:'FLAGP ^XBHEDD2 Q:FLAGQ I FLAGP D PAUSE Q:FLAGQ W @IOF W:IO'=IO(0) !!! D HD
|
|---|
| 40 | G LOOP
|
|---|
| 41 | PAUSE ;
|
|---|
| 42 | Q:IO'=IO(0)
|
|---|
| 43 | W !!?2,"<RETURN> to continue, '^' to quit: "
|
|---|
| 44 | R Z1:DTIME S:'$T Z1="^^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1
|
|---|
| 45 | Q
|
|---|
| 46 | WARN ;Warn if printing and over 100 fields in file
|
|---|
| 47 | W !?8,"This file has over 100 fields. Sure you want to print? YES//"
|
|---|
| 48 | 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
|
|---|
| 49 | Q
|
|---|
| 50 | HD ;
|
|---|
| 51 | W !?2,"NODE ; PIECE",?17,"FLD NUM",?48,"FIELD NAME",!?2,"------------",?17,"--------",?28,"-------------------------------------------------"
|
|---|
| 52 | Q
|
|---|
| 53 | KILL ;Kill variables
|
|---|
| 54 | K DASHES,EDDDATE,FILE,HD,LEVEL,PAGE,PAGETEMP,YCNT,^UTILITY($J,"LIST")
|
|---|
| 55 | Q
|
|---|
