- 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 ;
