source: IHS-VA_UTILITIES-XB/trunk/XBHEDD1.m@ 1119

Last change on this file since 1119 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 2.5 KB
RevLine 
[641]1XBHEDD1 ;402,DJB,10/23/91,EDD - FIELD Global Locations
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;;David Bolduc - Togus, ME
4PRINT ;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
14EN ;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
18EX ;
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
22ASK ;
23 W !?26,"""F""........ to select starting FIELD",!?26,"<RETURN>... for all fields"
24ASK1 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
30START ;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
33LOOP ;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
41PAUSE ;
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
46WARN ;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
50HD ;
51 W !?2,"NODE ; PIECE",?17,"FLD NUM",?48,"FIELD NAME",!?2,"------------",?17,"--------",?28,"-------------------------------------------------"
52 Q
53KILL ;Kill variables
54 K DASHES,EDDDATE,FILE,HD,LEVEL,PAGE,PAGETEMP,YCNT,^UTILITY($J,"LIST")
55 Q
Note: See TracBrowser for help on using the repository browser.