source: IHS-VA_UTILITIES-XB/trunk/XBDHD.m@ 1423

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

Modified directory structure; moved routines.

File size: 3.1 KB
Line 
1XBDHD ; IHS/ADC/GTH - GET BASIC INFO ABOUT FILE AND FIELDS ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4NEW ;
5 NEW XBDHCHLW,XBDHDFN,XBDHDFNA,XBDHECHN,XBDHHDN,XBDHHDNO,XBDHHDR,XBDHHDW,XBDHREM,XBDHTCHN,XBDHX,XBDHY,XBDHZ,DIC,Z,XBDHXX,XBDHCHN,XBDHPDFN,XBDHPDNA,XBDHDPTH,XBDHDSUB,XBDHNSL,XBDHLIFO,XBDHY0
6 W !!
7 I $D(^TMP("XBDH",$J,"SAVE")) D N1,^XBDHD1 S XBDHCHN=XBDHCHN+1 G STACK
8XBDHPDFN ;
9 S DIR(0)="PO^1:EMQ",DIR("A")="Output from what file",DIR("?")="Enter the name of the file from which you wish to print."
10 D ^DIR
11 KILL DIR
12 D DIRCK
13 I $D(XBDHQUIT) G EXIT
14 S XBDHPDFN=+Y,XBDHPDNA=$P(Y,U,2),^TMP("XBDH",$J,"HEADER")=+Y_U_XBDHPDNA
15 W !
16 ;
17HEADER ;
18 I $D(XBDHDATA) S DHD="@",XBDHTHLW=240 G START
19 S Z=XBDHPDNA
20 S:$E(Z,$L(Z)-4,$L(Z))=" LIST" Z=$E(Z,1,$L(Z)-5)
21 S DIR(0)="FO^:",DIR("A")="Report heading",DIR("B")=Z_" LIST"
22 D ^DIR
23 KILL DIR
24 D DIRCK
25 I $D(XBDHQUIT) G EXIT
26 S DHD=X
27 I DHD="" S DHD="@"
28 W !
29 ;
30THLW ;
31 S DIR(0)="NO^1:256:",DIR("A")="Header line width",DIR("B")="132",DIR("?")="between 1 and 256"
32 D ^DIR
33 KILL DIR
34 S XBDHTHLW=Y
35 I "^"[XBDHTHLW G EXIT
36 ;
37START ;
38 S XBDHTCHN="",XBDHCHLW=0,XBDHCHN=1,XBDHNSL=XBDHTHLW
39STACK ;
40 KILL ^TMP("XBDH",$J,"STACK")
41 S ^TMP("XBDH",$J,"STACK",1)=XBDHPDFN_U_XBDHPDNA_U_U,XBDHLIFO=1
42 ;
43FIELD ;
44 KILL Y,XBDHY0
45 D ^XBDHDF
46 I Y="",$D(^TMP("XBDH",$J,"HEADER",1)),XBDHLIFO=1 S ^TMP("XBDH",$J,"SAVE")=XBDHCHN_U_XBDHCHLW_U_XBDHNSL D:$D(^TMP("XBDH",$J,"HEADER",2)) ^XBDHDSP G EXIT
47 I "^"[Y S:Y=U XBDHQUIT="" G EXIT
48 I Y?1"."1U S XBDHREL="" G RESET
49 ;
50HDR ;
51 I $D(Y(0))#2 S XBDHY0=Y(0)
52 S Z=$J("",(XBDHLIFO*2)-2),DIR(0)="FO^:",DIR("A")=Z_"Column header",DIR("B")=XBDHHDN,DIR("?")="Enter the label you want to appear at the top of this column"
53 D ^DIR
54 KILL DIR
55 S XBDHHDR=Y
56 I "^"[XBDHHDR W !! G EXIT
57 I $L(XBDHHDN)>XBDHNSL W *7,*7,!!,"THIS HEADER WILL NOT FIT ON THE LINE...TRY AGAIN",!! G HDR
58 ;
59HDW ;
60 I '$D(XBDHY0) S XBDHZ=XBDHNSL G WIDTH
61 I $P(XBDHY0,U,2)["D",$L(XBDHHDR)<13,XBDHNSL>11 S XBDHZ=12 G WIDTH
62 S XBDHZ="",XBDHX=$P(XBDHY0,U,5),XBDHY="$L(X)>"
63 I XBDHX[XBDHY S XBDHZ=+$P(XBDHX,XBDHY,2) S:XBDHZ<$L(XBDHHDR) XBDHZ=$L(XBDHHDR) S:+$P(XBDHX,XBDHY,2)>XBDHNSL XBDHZ=XBDHNSL
64WIDTH ;
65 S Z=$J("",(XBDHLIFO*2)-2)
66 KILL XBDHY0
67 S DIR(0)="NO^"_$L(XBDHHDR)_":"_XBDHNSL_":",DIR("A")=Z_"Enter the width (in columns) of this field",DIR("B")=XBDHZ,DIR("?")="Must not be narrower than column header or wider than remaining space"
68 D ^DIR
69 KILL DIR
70 S XBDHHDW=Y
71 I XBDHHDW="" W ! G HDR
72 I XBDHHDW="^" W !! G EXIT
73 I XBDHHDW=+XBDHHDW,XBDHHDW'<$L(XBDHHDR),XBDHHDW'>XBDHNSL S $P(^TMP("XBDH",$J,"HEADER"),U,3)=XBDHTHLW G GLOB
74 W *7,*7,*13,$J("",IOM),*13
75 G HDW
76 ;
77GLOB ;
78 S V="|",^TMP("XBDH",$J,"HEADER",XBDHCHN)=XBDHDFN_"~"_XBDHHDNO_"~~"_XBDHDPTH_V_XBDHHDN_V_XBDHHDR_V_XBDHHDW_"|0|||0"
79RESET ;
80 D ^XBDHD1,^XBDHD2
81 I $D(XBDHQUIT) G EXIT
82 S XBDHCHN=XBDHCHN+1
83 I $D(XBDHREL) KILL XBDHREL D ^XBDHD1 S XBDHCHN=XBDHCHN+1 G STACK
84 G FIELD
85 ;
86N1 ;
87 S V="|",X=^TMP("XBDH",$J,"SAVE"),XBDHCHN=$P(X,U),XBDHCHLW=$P(X,U,2),XBDHNSL=$P(X,U,3),XBDHTCHN="",X=^("HEADER"),XBDHPDFN=$P(X,U),XBDHPDNA=$P(X,U,2),XBDHTHLW=$P(X,U,3)
88 KILL X
89 Q
90 ;
91EXIT ;
92 Q
93 ;
94DIRCK ;
95 I Y=""!($D(DIRUT))!($D(DTOUT)) S XBDHQUIT="" KILL DIRUT,DTOUT,DUOUT,DIROUT
96 Q
97 ;
Note: See TracBrowser for help on using the repository browser.