XBDHD ; IHS/ADC/GTH - GET BASIC INFO ABOUT FILE AND FIELDS ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
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 !
;
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
;
XBDHD ; IHS/ADC/GTH - GET BASIC INFO ABOUT FILE AND FIELDS ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
NEW ;
+1 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
+2 WRITE !!
+3 IF $DATA(^TMP("XBDH",$JOB,"SAVE"))
DO N1
DO ^XBDHD1
SET XBDHCHN=XBDHCHN+1
GOTO STACK
XBDHPDFN ;
+1 SET DIR(0)="PO^1:EMQ"
SET DIR("A")="Output from what file"
SET DIR("?")="Enter the name of the file from which you wish to print."
+2 DO ^DIR
+3 KILL DIR
+4 DO DIRCK
+5 IF $DATA(XBDHQUIT)
GOTO EXIT
+6 SET XBDHPDFN=+Y
SET XBDHPDNA=$PIECE(Y,U,2)
SET ^TMP("XBDH",$JOB,"HEADER")=+Y_U_XBDHPDNA
+7 WRITE !
+8 ;
+1 IF $DATA(XBDHDATA)
SET DHD="@"
SET XBDHTHLW=240
GOTO START
+2 SET Z=XBDHPDNA
+3 IF $EXTRACT(Z,$LENGTH(Z)-4,$LENGTH(Z))=" LIST"
SET Z=$EXTRACT(Z,1,$LENGTH(Z)-5)
+4 SET DIR(0)="FO^:"
SET DIR("A")="Report heading"
SET DIR("B")=Z_" LIST"
+5 DO ^DIR
+6 KILL DIR
+7 DO DIRCK
+8 IF $DATA(XBDHQUIT)
GOTO EXIT
+9 SET DHD=X
+10 IF DHD=""
SET DHD="@"
+11 WRITE !
+12 ;
THLW ;
+1 SET DIR(0)="NO^1:256:"
SET DIR("A")="Header line width"
SET DIR("B")="132"
SET DIR("?")="between 1 and 256"
+2 DO ^DIR
+3 KILL DIR
+4 SET XBDHTHLW=Y
+5 IF "^"[XBDHTHLW
GOTO EXIT
+6 ;
START ;
+1 SET XBDHTCHN=""
SET XBDHCHLW=0
SET XBDHCHN=1
SET XBDHNSL=XBDHTHLW
STACK ;
+1 KILL ^TMP("XBDH",$JOB,"STACK")
+2 SET ^TMP("XBDH",$JOB,"STACK",1)=XBDHPDFN_U_XBDHPDNA_U_U
SET XBDHLIFO=1
+3 ;
FIELD ;
+1 KILL Y,XBDHY0
+2 DO ^XBDHDF
+3 IF Y=""
IF $DATA(^TMP("XBDH",$JOB,"HEADER",1))
IF XBDHLIFO=1
SET ^TMP("XBDH",$JOB,"SAVE")=XBDHCHN_U_XBDHCHLW_U_XBDHNSL
IF $DATA(^TMP("XBDH",$JOB,"HEADER",2))
DO ^XBDHDSP
GOTO EXIT
+4 IF "^"[Y
IF Y=U
SET XBDHQUIT=""
GOTO EXIT
+5 IF Y?1"."1U
SET XBDHREL=""
GOTO RESET
+6 ;
HDR ;
+1 IF $DATA(Y(0))#2
SET XBDHY0=Y(0)
+2 SET Z=$JUSTIFY("",(XBDHLIFO*2)-2)
SET DIR(0)="FO^:"
SET DIR("A")=Z_"Column header"
SET DIR("B")=XBDHHDN
SET DIR("?")="Enter the label you want to appear at the top of this column"
+3 DO ^DIR
+4 KILL DIR
+5 SET XBDHHDR=Y
+6 IF "^"[XBDHHDR
WRITE !!
GOTO EXIT
+7 IF $LENGTH(XBDHHDN)>XBDHNSL
WRITE *7,*7,!!,"THIS HEADER WILL NOT FIT ON THE LINE...TRY AGAIN",!!
GOTO HDR
+8 ;
HDW ;
+1 IF '$DATA(XBDHY0)
SET XBDHZ=XBDHNSL
GOTO WIDTH
+2 IF $PIECE(XBDHY0,U,2)["D"
IF $LENGTH(XBDHHDR)<13
IF XBDHNSL>11
SET XBDHZ=12
GOTO WIDTH
+3 SET XBDHZ=""
SET XBDHX=$PIECE(XBDHY0,U,5)
SET XBDHY="$L(X)>"
+4 IF XBDHX[XBDHY
SET XBDHZ=+$PIECE(XBDHX,XBDHY,2)
IF XBDHZ<$LENGTH(XBDHHDR)
SET XBDHZ=$LENGTH(XBDHHDR)
IF +$PIECE(XBDHX,XBDHY,2)>XBDHNSL
SET XBDHZ=XBDHNSL
WIDTH ;
+1 SET Z=$JUSTIFY("",(XBDHLIFO*2)-2)
+2 KILL XBDHY0
+3 SET DIR(0)="NO^"_$LENGTH(XBDHHDR)_":"_XBDHNSL_":"
SET DIR("A")=Z_"Enter the width (in columns) of this field"
SET DIR("B")=XBDHZ
SET DIR("?")="Must not be narrower than column header or wider than remaining space"
+4 DO ^DIR
+5 KILL DIR
+6 SET XBDHHDW=Y
+7 IF XBDHHDW=""
WRITE !
GOTO HDR
+8 IF XBDHHDW="^"
WRITE !!
GOTO EXIT
+9 IF XBDHHDW=+XBDHHDW
IF XBDHHDW'<$LENGTH(XBDHHDR)
IF XBDHHDW'>XBDHNSL
SET $PIECE(^TMP("XBDH",$JOB,"HEADER"),U,3)=XBDHTHLW
GOTO GLOB
+10 WRITE *7,*7,*13,$JUSTIFY("",IOM),*13
+11 GOTO HDW
+12 ;
GLOB ;
+1 SET V="|"
SET ^TMP("XBDH",$JOB,"HEADER",XBDHCHN)=XBDHDFN_"~"_XBDHHDNO_"~~"_XBDHDPTH_V_XBDHHDN_V_XBDHHDR_V_XBDHHDW_"|0|||0"
RESET ;
+1 DO ^XBDHD1
DO ^XBDHD2
+2 IF $DATA(XBDHQUIT)
GOTO EXIT
+3 SET XBDHCHN=XBDHCHN+1
+4 IF $DATA(XBDHREL)
KILL XBDHREL
DO ^XBDHD1
SET XBDHCHN=XBDHCHN+1
GOTO STACK
+5 GOTO FIELD
+6 ;
N1 ;
+1 SET V="|"
SET X=^TMP("XBDH",$JOB,"SAVE")
SET XBDHCHN=$PIECE(X,U)
SET XBDHCHLW=$PIECE(X,U,2)
SET XBDHNSL=$PIECE(X,U,3)
SET XBDHTCHN=""
SET X=^("HEADER")
SET XBDHPDFN=$PIECE(X,U)
SET XBDHPDNA=$PIECE(X,U,2)
SET XBDHTHLW=$PIECE(X,U,3)
+2 KILL X
+3 QUIT
+4 ;
EXIT ;
+1 QUIT
+2 ;
DIRCK ;
+1 IF Y=""!($DATA(DIRUT))!($DATA(DTOUT))
SET XBDHQUIT=""
KILL DIRUT,DTOUT,DUOUT,DIROUT
+2 QUIT
+3 ;
