Routine: XBDHD1

XBDHD1 ; IHS/ADC/GTH - COMPILES HEADER LINE ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

NEW ;

 NEW XBDHCHN2,XBDHHDPD,XBDHHDSP,XBDHL1,XBDHL2,XBDHL3,DX,DY

INIT ;

 W @IOF

 X XBDHWOFF

 S (XBDHL1,XBDHL2,XBDHL3,XBDHCHN2)="",XBDHCHLW=0,DX=0,XBDHNSL=XBDHTHLW

 F XBDHL=0:0 S XBDHCHN2=$O(^TMP("XBDH",$J,"HEADER",XBDHCHN2)) Q:XBDHCHN2=""  D:((XBDHCHN2\1)=XBDHCHN2) VAR W "."

 W @IOF

WLINE ;

 F XBDHZ=1:1:4 Q:XBDHZ>(((XBDHTHLW-1)\80)+1)  D LINE

FIN ;

 S DY=(3*XBDHZ)+1,XBDHX="",$P(XBDHX,"-",79)=""

 X IOXY

 W XBDHX,!

EXIT ;

LINE ;

 S DY=(XBDHZ*3)-2,XBDHX=80*XBDHZ

 F XBDHY="XBDHL1","XBDHL3" S DY=DY+1 X IOXY W $E(@XBDHY,XBDHX-79,XBDHX)

VAR ;

 S XBDHHDR=$P(^TMP("XBDH",$J,"HEADER",XBDHCHN2),V,3),XBDHHDW=$P(^(XBDHCHN2),V,4),XBDHHDPD=$P(^(XBDHCHN2),V,5),XBDHHDSP=$P(^(XBDHCHN2),V,8),XBDHCHLW=XBDHCHLW+XBDHHDW,XBDHCHN=XBDHCHN2,XBDHNSL=XBDHNSL-(XBDHHDW+XBDHHDSP)

 S XBDHL1=XBDHL1_$J("",XBDHHDPD)_XBDHHDR_$J("",(XBDHHDW-$L(XBDHHDR)-XBDHHDPD+XBDHHDSP))

 S XBDHXX=$C(64+XBDHCHN2)

 I $D(XBDHECHN),XBDHECHN=XBDHCHN2 S XBDHXX="^"

 S XBDHX="",$P(XBDHX,XBDHXX,XBDHHDW+1)="",XBDHY="",$P(XBDHY,".",XBDHHDSP+1)="" S XBDHL2=XBDHL2_XBDHX_XBDHY

L3 ;

 S XBDHX="",$P(XBDHX,".",(XBDHTHLW+1-$L(XBDHL2)))="",XBDHL3=XBDHL2_XBDHX

 KILL XBDHXX,XBDHX,XBDHY

NOTES ;

 ; WRITES THE CURRENT HEADER LINE AT THE TOP OF THE SCREEN

 ; INPUT = ^TMP("XBDH",$J,"HEADER",N),XBDHTHLW

 ; OUTPUT = XBDHHDSP,XBDHHDPD

 ; ALSO WRITES THE FIELD BOUNDARY LINE (AAAAAABBBCCCCC...) BELOW THE HEADER LINE

 ; THIS ROUTINE IS CALLED EVERY TIME THE HEADER LINE IS CHANGED BY THE EDITING PROCESS

XBDHD1    ; IHS/ADC/GTH - COMPILES HEADER LINE ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

NEW       ;

 +1        NEW XBDHCHN2,XBDHHDPD,XBDHHDSP,XBDHL1,XBDHL2,XBDHL3,DX,DY

INIT      ;

 +1        WRITE @IOF

 +2        XECUTE XBDHWOFF

 +3        SET (XBDHL1,XBDHL2,XBDHL3,XBDHCHN2)=""

           SET XBDHCHLW=0

           SET DX=0

           SET XBDHNSL=XBDHTHLW

 +4        FOR XBDHL=0:0

               SET XBDHCHN2=$ORDER(^TMP("XBDH",$JOB,"HEADER",XBDHCHN2))

               IF XBDHCHN2=""

                   QUIT

               IF ((XBDHCHN2\1)=XBDHCHN2)

                   DO VAR

               WRITE "."

 +5        WRITE @IOF

WLINE     ;

 +1        FOR XBDHZ=1:1:4

               IF XBDHZ>(((XBDHTHLW-1)\80)+1)

                   QUIT

               DO LINE

FIN       ;

 +1        SET DY=(3*XBDHZ)+1

           SET XBDHX=""

           SET $PIECE(XBDHX,"-",79)=""

 +2        XECUTE IOXY

 +3        WRITE XBDHX,!

EXIT      ;

 +1        QUIT

 +2       ;

LINE      ;

 +1        SET DY=(XBDHZ*3)-2

           SET XBDHX=80*XBDHZ

 +2        FOR XBDHY="XBDHL1","XBDHL3"

               SET DY=DY+1

               XECUTE IOXY

               WRITE $EXTRACT(@XBDHY,XBDHX-79,XBDHX)

 +3        QUIT

 +4       ;

VAR       ;

 +1        SET XBDHHDR=$PIECE(^TMP("XBDH",$JOB,"HEADER",XBDHCHN2),V,3)

           SET XBDHHDW=$PIECE(^(XBDHCHN2),V,4)

           SET XBDHHDPD=$PIECE(^(XBDHCHN2),V,5)

           SET XBDHHDSP=$PIECE(^(XBDHCHN2),V,8)

           SET XBDHCHLW=XBDHCHLW+XBDHHDW

           SET XBDHCHN=XBDHCHN2

           SET XBDHNSL=XBDHNSL-(XBDHHDW+XBDHHDSP)

 +2        SET XBDHL1=XBDHL1_$JUSTIFY("",XBDHHDPD)_XBDHHDR_$JUSTIFY("",(XBDHHDW-$LENGTH(XBDHHDR)-XBDHHDPD+XBDHHDSP))

 +3        SET XBDHXX=$CHAR(64+XBDHCHN2)

 +4        IF $DATA(XBDHECHN)

               IF XBDHECHN=XBDHCHN2

                   SET XBDHXX="^"

 +5        SET XBDHX=""

           SET $PIECE(XBDHX,XBDHXX,XBDHHDW+1)=""

           SET XBDHY=""

           SET $PIECE(XBDHY,".",XBDHHDSP+1)=""

           SET XBDHL2=XBDHL2_XBDHX_XBDHY

L3        ;

 +1        SET XBDHX=""

           SET $PIECE(XBDHX,".",(XBDHTHLW+1-$LENGTH(XBDHL2)))=""

           SET XBDHL3=XBDHL2_XBDHX

 +2        KILL XBDHXX,XBDHX,XBDHY

 +3        QUIT

 +4       ;

NOTES     ;

 +1       ; WRITES THE CURRENT HEADER LINE AT THE TOP OF THE SCREEN

 +2       ; INPUT = ^TMP("XBDH",$J,"HEADER",N),XBDHTHLW

 +3       ; OUTPUT = XBDHHDSP,XBDHHDPD

 +4       ; ALSO WRITES THE FIELD BOUNDARY LINE (AAAAAABBBCCCCC...) BELOW THE HEADER LINE

 +5       ; THIS ROUTINE IS CALLED EVERY TIME THE HEADER LINE IS CHANGED BY THE EDITING PROCESS

XBDHD1.m