98 lines
3.1 KiB
Mathematica
98 lines
3.1 KiB
Mathematica
|
XBDHD ; IHS/ADC/GTH - GET BASIC INFO ABOUT FILE AND FIELDS ; [ 02/07/97 3:02 PM ]
|
||
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
||
|
|
;
|
||
|
|
NEW ;
|
||
|
|
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
|
||
|
|
W !!
|
||
|
|
I $D(^TMP("XBDH",$J,"SAVE")) D N1,^XBDHD1 S XBDHCHN=XBDHCHN+1 G STACK
|
||
|
|
XBDHPDFN ;
|
||
|
|
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."
|
||
|
|
D ^DIR
|
||
|
|
KILL DIR
|
||
|
|
D DIRCK
|
||
|
|
I $D(XBDHQUIT) G EXIT
|
||
|
|
S XBDHPDFN=+Y,XBDHPDNA=$P(Y,U,2),^TMP("XBDH",$J,"HEADER")=+Y_U_XBDHPDNA
|
||
|
|
W !
|
||
|
|
;
|
||
|
|
HEADER ;
|
||
|
|
I $D(XBDHDATA) S DHD="@",XBDHTHLW=240 G START
|
||
|
|
S Z=XBDHPDNA
|
||
|
|
S:$E(Z,$L(Z)-4,$L(Z))=" LIST" Z=$E(Z,1,$L(Z)-5)
|
||
|
|
S DIR(0)="FO^:",DIR("A")="Report heading",DIR("B")=Z_" LIST"
|
||
|
|
D ^DIR
|
||
|
|
KILL DIR
|
||
|
|
D DIRCK
|
||
|
|
I $D(XBDHQUIT) G EXIT
|
||
|
|
S DHD=X
|
||
|
|
I DHD="" S DHD="@"
|
||
|
|
W !
|
||
|
|
;
|
||
|
|
THLW ;
|
||
|
|
S DIR(0)="NO^1:256:",DIR("A")="Header line width",DIR("B")="132",DIR("?")="between 1 and 256"
|
||
|
|
D ^DIR
|
||
|
|
KILL DIR
|
||
|
|
S XBDHTHLW=Y
|
||
|
|
I "^"[XBDHTHLW G EXIT
|
||
|
|
;
|
||
|
|
START ;
|
||
|
|
S XBDHTCHN="",XBDHCHLW=0,XBDHCHN=1,XBDHNSL=XBDHTHLW
|
||
|
|
STACK ;
|
||
|
|
KILL ^TMP("XBDH",$J,"STACK")
|
||
|
|
S ^TMP("XBDH",$J,"STACK",1)=XBDHPDFN_U_XBDHPDNA_U_U,XBDHLIFO=1
|
||
|
|
;
|
||
|
|
FIELD ;
|
||
|
|
KILL Y,XBDHY0
|
||
|
|
D ^XBDHDF
|
||
|
|
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
|
||
|
|
I "^"[Y S:Y=U XBDHQUIT="" G EXIT
|
||
|
|
I Y?1"."1U S XBDHREL="" G RESET
|
||
|
|
;
|
||
|
|
HDR ;
|
||
|
|
I $D(Y(0))#2 S XBDHY0=Y(0)
|
||
|
|
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"
|
||
|
|
D ^DIR
|
||
|
|
KILL DIR
|
||
|
|
S XBDHHDR=Y
|
||
|
|
I "^"[XBDHHDR W !! G EXIT
|
||
|
|
I $L(XBDHHDN)>XBDHNSL W *7,*7,!!,"THIS HEADER WILL NOT FIT ON THE LINE...TRY AGAIN",!! G HDR
|
||
|
|
;
|
||
|
|
HDW ;
|
||
|
|
I '$D(XBDHY0) S XBDHZ=XBDHNSL G WIDTH
|
||
|
|
I $P(XBDHY0,U,2)["D",$L(XBDHHDR)<13,XBDHNSL>11 S XBDHZ=12 G WIDTH
|
||
|
|
S XBDHZ="",XBDHX=$P(XBDHY0,U,5),XBDHY="$L(X)>"
|
||
|
|
I XBDHX[XBDHY S XBDHZ=+$P(XBDHX,XBDHY,2) S:XBDHZ<$L(XBDHHDR) XBDHZ=$L(XBDHHDR) S:+$P(XBDHX,XBDHY,2)>XBDHNSL XBDHZ=XBDHNSL
|
||
|
|
WIDTH ;
|
||
|
|
S Z=$J("",(XBDHLIFO*2)-2)
|
||
|
|
KILL XBDHY0
|
||
|
|
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"
|
||
|
|
D ^DIR
|
||
|
|
KILL DIR
|
||
|
|
S XBDHHDW=Y
|
||
|
|
I XBDHHDW="" W ! G HDR
|
||
|
|
I XBDHHDW="^" W !! G EXIT
|
||
|
|
I XBDHHDW=+XBDHHDW,XBDHHDW'<$L(XBDHHDR),XBDHHDW'>XBDHNSL S $P(^TMP("XBDH",$J,"HEADER"),U,3)=XBDHTHLW G GLOB
|
||
|
|
W *7,*7,*13,$J("",IOM),*13
|
||
|
|
G HDW
|
||
|
|
;
|
||
|
|
GLOB ;
|
||
|
|
S V="|",^TMP("XBDH",$J,"HEADER",XBDHCHN)=XBDHDFN_"~"_XBDHHDNO_"~~"_XBDHDPTH_V_XBDHHDN_V_XBDHHDR_V_XBDHHDW_"|0|||0"
|
||
|
|
RESET ;
|
||
|
|
D ^XBDHD1,^XBDHD2
|
||
|
|
I $D(XBDHQUIT) G EXIT
|
||
|
|
S XBDHCHN=XBDHCHN+1
|
||
|
|
I $D(XBDHREL) KILL XBDHREL D ^XBDHD1 S XBDHCHN=XBDHCHN+1 G STACK
|
||
|
|
G FIELD
|
||
|
|
;
|
||
|
|
N1 ;
|
||
|
|
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)
|
||
|
|
KILL X
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EXIT ;
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DIRCK ;
|
||
|
|
I Y=""!($D(DIRUT))!($D(DTOUT)) S XBDHQUIT="" KILL DIRUT,DTOUT,DUOUT,DIROUT
|
||
|
|
Q
|
||
|
|
;
|