source: IHS-VA_UTILITIES-XB/XBDHD1.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 15 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 1.5 KB
RevLine 
[641]1XBDHD1 ; IHS/ADC/GTH - COMPILES HEADER LINE ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4NEW ;
5 NEW XBDHCHN2,XBDHHDPD,XBDHHDSP,XBDHL1,XBDHL2,XBDHL3,DX,DY
6INIT ;
7 W @IOF
8 X XBDHWOFF
9 S (XBDHL1,XBDHL2,XBDHL3,XBDHCHN2)="",XBDHCHLW=0,DX=0,XBDHNSL=XBDHTHLW
10 F XBDHL=0:0 S XBDHCHN2=$O(^TMP("XBDH",$J,"HEADER",XBDHCHN2)) Q:XBDHCHN2="" D:((XBDHCHN2\1)=XBDHCHN2) VAR W "."
11 W @IOF
12WLINE ;
13 F XBDHZ=1:1:4 Q:XBDHZ>(((XBDHTHLW-1)\80)+1) D LINE
14FIN ;
15 S DY=(3*XBDHZ)+1,XBDHX="",$P(XBDHX,"-",79)=""
16 X IOXY
17 W XBDHX,!
18EXIT ;
19 Q
20 ;
21LINE ;
22 S DY=(XBDHZ*3)-2,XBDHX=80*XBDHZ
23 F XBDHY="XBDHL1","XBDHL3" S DY=DY+1 X IOXY W $E(@XBDHY,XBDHX-79,XBDHX)
24 Q
25 ;
26VAR ;
27 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)
28 S XBDHL1=XBDHL1_$J("",XBDHHDPD)_XBDHHDR_$J("",(XBDHHDW-$L(XBDHHDR)-XBDHHDPD+XBDHHDSP))
29 S XBDHXX=$C(64+XBDHCHN2)
30 I $D(XBDHECHN),XBDHECHN=XBDHCHN2 S XBDHXX="^"
31 S XBDHX="",$P(XBDHX,XBDHXX,XBDHHDW+1)="",XBDHY="",$P(XBDHY,".",XBDHHDSP+1)="" S XBDHL2=XBDHL2_XBDHX_XBDHY
32L3 ;
33 S XBDHX="",$P(XBDHX,".",(XBDHTHLW+1-$L(XBDHL2)))="",XBDHL3=XBDHL2_XBDHX
34 KILL XBDHXX,XBDHX,XBDHY
35 Q
36 ;
37NOTES ;
38 ; WRITES THE CURRENT HEADER LINE AT THE TOP OF THE SCREEN
39 ; INPUT = ^TMP("XBDH",$J,"HEADER",N),XBDHTHLW
40 ; OUTPUT = XBDHHDSP,XBDHHDPD
41 ; ALSO WRITES THE FIELD BOUNDARY LINE (AAAAAABBBCCCCC...) BELOW THE HEADER LINE
42 ; THIS ROUTINE IS CALLED EVERY TIME THE HEADER LINE IS CHANGED BY THE EDITING PROCESS
Note: See TracBrowser for help on using the repository browser.