XBDHD2	; IHS/ADC/GTH - SPECIAL CHOICES ; [ 02/07/97   3:02 PM ]
	;;4.0;XB;;Jul 20, 2009;Build 2
	;
NEW	;
	NEW XBDHFROM,XBDHI,XBDHTEMP,XBDHTO
	; 
START	;
	I $D(XBDHECHN) S XBDHCHN=XBDHECHN,XBDHX=^TMP("XBDH",$J,"HEADER",XBDHCHN),XBDHHDR=$P(XBDHX,V,3),XBDHHDW=$P(XBDHX,V,4)
	W "EDITING HEADER LINE SEGMENT """,$C(64+XBDHCHN),"""     FIELD = """,$P(^TMP("XBDH",$J,"HEADER",XBDHCHN),V,2),"""",!
	F XBDHI=1:1:7 W $E($T(TEXT+XBDHI),4,99),!
	W !
CNEXT	;
	S DIR(0)="NO^1:8:",DIR("A")="Your choice",DIR("?")="Enter the number of the editing function or <CR> to go on"
	D ^DIR
	KILL DIR
	S XBDHX=Y
	I "^"[XBDHX KILL XBDHECHN Q
	G @("C"_XBDHX)
	; 
C1	;
	S $P(^TMP("XBDH",$J,"HEADER",XBDHCHN),V,5)=(XBDHHDW-$L(XBDHHDR))\2
	D ^XBDHD1
	G START
	; 
C2	;
	S $P(^TMP("XBDH",$J,"HEADER",XBDHCHN),V,5)=0
	D ^XBDHD1
	G START
	; 
C3	;
	W !!
C31	;
	S DIR(0)="NO^"_$L(XBDHHDR)_":"_(XBDHNSL+XBDHHDW)_":",DIR("A")="New field width"
	D ^DIR
	KILL DIR
	S XBDHX=Y
	I "^"[XBDHX G START
	I XBDHX'=+XBDHX W *13,$J("",IOM),*13,*7,*7 G C31
	I (XBDHX<$L(XBDHHDR))!(XBDHX>(XBDHNSL+XBDHHDW)) W *7,*7,*13,$J("",IOM),*13 G C31
	S XBDHHDW=XBDHX,$P(^TMP("XBDH",$J,"HEADER",XBDHCHN),V,4)=XBDHX G:$E($P(^(XBDHCHN),V,5)) C1
	D ^XBDHD1
	G START
	; 
C4	;
	W !!
	S DIR(0)="FO^1:"_XBDHHDW_"",DIR("A")="New header name"
	D ^DIR
	KILL DIR
	S XBDHX=Y
	I XBDHX="" G C8
	I XBDHX=U G START
	I $P(^TMP("XBDH",$J,"HEADER",XBDHCHN),V,5) S $P(^TMP("XBDH",$J,"HEADER",XBDHCHN),V,3)=XBDHX,XBDHHDR=XBDHX G C1
	S $P(^TMP("XBDH",$J,"HEADER",XBDHCHN),V,3)=XBDHX
	D ^XBDHD1
	G START
	; 
C5	;
	S $P(^TMP("XBDH",$J,"HEADER",XBDHCHN),V,6)="+"
	W !!,"ENTRIES RIGHT JUSTIFIED TO A WIDTH OF ",XBDHHDW," COLUMNS"
	H 2
	D ^XBDHD1
	G START
	; 
C6	;
	S $P(^TMP("XBDH",$J,"HEADER",XBDHCHN),V,7)="+"
	W !!,"ENTRIES WILL BE WORD WRAPPED TO A WIDTH OF ",XBDHHDW," COLUMNS"
	H 2
	D ^XBDHD1
	G START
	; 
C7	;
	I '$D(XBDHECHN) KILL ^TMP("XBDH",$J,"HEADER",XBDHCHN) D ^XBDHD1 Q
	S X=""
	F L=0:0 S X=$O(^TMP("XBDH",$J,"HEADER",X)) Q:X=""  S ^TMP("XBDH",$J,"HT",X)=^TMP("XBDH",$J,"HEADER",X) W "."
	S XBDHTEMP=^TMP("XBDH",$J,"HEADER")
	KILL ^TMP("XBDH",$J,"HT",XBDHECHN),^TMP("XBDH",$J,"HEADER")
	S X=""
	F I=1:1 S X=$O(^TMP("XBDH",$J,"HT",X)) Q:X=""  S ^TMP("XBDH",$J,"HEADER",I)=^TMP("XBDH",$J,"HT",X) W "."
	S ^TMP("XBDH",$J,"HEADER")=XBDHTEMP
	KILL ^TMP("XBDH",$J,"HT"),XBDHTEMP
	KILL XBDHECHN
	D ^XBDHD1
	Q
	; 
C8	;
	S XBDHFROM=$S($D(XBDHECHN):XBDHECHN,1:XBDHCHN),XBDHFROM=$C(64+XBDHFROM)
	S X=""
	F XBDHTCHN=0:1 S X=$O(^TMP("XBDH",$J,"HEADER",X)) Q:X=""  S ^TMP("XBDH",$J,"HT",X)=^(X) W "." S Y="" F L=0:0 S Y=$O(^TMP("XBDH",$J,"HEADER",X,Y)) Q:Y=""  S ^TMP("XBDH",$J,"HT",X,Y)=^(Y)
	I XBDHCHN<2 W *7,*13,$J("",IOM),*13 G CNEXT
	W *13,$J("",IOM),*13
	; 
MOVE	;
	S DIR(0)="FO^",DIR("A")="Where do you want to move this header (A - "_$C(64+XBDHTCHN)_")",DIR("?")="Enter a letter which corresponds to a header line field"
	D ^DIR
	KILL DIR
	S XBDHTO=Y
	I "^"[XBDHTO W ! G START
	I XBDHTO'?1U W *7,*7,*13,$J("",IOM),*13 G MOVE
	I XBDHTO]$C(64+XBDHCHN) W *7,*7,*13,$J("",IOM),*13 G MOVE
	I XBDHFROM=XBDHTO W *7,*13,$J("",IOM),*13 G MOVE
	S XBDHFROM=$A(XBDHFROM)-64,XBDHTO=$A(XBDHTO)-64
	S XBDHX=XBDHTO+.1
	S:(XBDHFROM>XBDHTO) XBDHX=XBDHTO-.1
	S ^TMP("XBDH",$J,"HT",XBDHX)=^TMP("XBDH",$J,"HEADER",XBDHFROM)
	S Y=""
	F L=0:0 S Y=$O(^TMP("XBDH",$J,"HEADER",XBDHFROM,Y)) Q:Y=""  S ^TMP("XBDH",$J,"HT",XBDHX,Y)=^TMP("XBDH",$J,"HEADER",XBDHFROM,Y)
	S XBDHTEMP=^TMP("XBDH",$J,"HEADER")
	KILL ^TMP("XBDH",$J,"HT",XBDHFROM),^TMP("XBDH",$J,"HEADER")
	S X=""
	F I=1:1 S X=$O(^TMP("XBDH",$J,"HT",X)) Q:X=""  S ^TMP("XBDH",$J,"HEADER",I)=^TMP("XBDH",$J,"HT",X) S Y="" F L=0:0 S Y=$O(^TMP("XBDH",$J,"HT",X,Y)) Q:Y=""  S ^TMP("XBDH",$J,"HEADER",I,Y)=^TMP("XBDH",$J,"HT",X,Y)
	S ^TMP("XBDH",$J,"HEADER")=XBDHTEMP
	KILL ^TMP("XBDH",$J,"HT"),XBDHTEMP,XBDHECHN
	D ^XBDHD1
	G START
	; 
TEXT	; 
	;;DO YOU WANT TO MAKE ANY OTHER CHANGES TO THIS HEADER OR ITS FIELD?
	;;
	;;  <CR> ACCEPT HEADER AS IS            
	;;  1) CENTER HEADER WITHIN FIELD       5) RIGHT JUSTIFY ENTRIES
	;;  2) UNCENTER HEADER                  6) WORD WRAP ENTRIES
	;;  3) CHANGE FIELD WIDTH               7) REMOVE THIS HEADER
	;;  4) CHANGE HEADER NAME               8) MOVE THIS HEADER
	; 
NOTES	; 
	; MAKES SECONDARY EDITING CHANGES AFTER EACH FIELD IS ENTERED
	; INPUT = XBDHCHN OR XBDHECHN (XBDHECHN IS THE .A OR .B CHN),^TMP("XBDH",$J,"HEADER",CHN),XBDHTHLW
	; OUTPUT = RESET ^TMP("XBDH",$J,"HEADER",CHN)
	; TO INSERT A NEW FIELD SIMPLY APPEND IT TO THE END OF THE LINE AND THE MOVE IT