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

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
        ;