| 1 | XBDH ; IHS/ADC/GTH - HEADER EDITOR MAIN ROUTINE ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ; Thanks to Dr. Dave Grau, OHPRD/TUCSON, for the original
|
|---|
| 5 | ; routine.
|
|---|
| 6 | ;
|
|---|
| 7 | ; THIS ROUTINE IS DEDICATED TO MY FRIEND AND MENTOR,
|
|---|
| 8 | ; KEN FLESHMAN M.D.
|
|---|
| 9 | ;
|
|---|
| 10 | ; Version 11.1 is dedicated to Maureen Hoye and Tami Winn
|
|---|
| 11 | ; who made it possible to create a "legal", distributable
|
|---|
| 12 | ; package. Sincere thanks!!!
|
|---|
| 13 | ;
|
|---|
| 14 | VAR ;
|
|---|
| 15 | NEW XBDHMORE,DHD,V,X,Y,XBDHPDFN,XBDHPDNA,XBDHTHLW,XBDHL,XBDHI,%Y,%,A,C,Z,I,XBDHMFLG,XBDHWOFF
|
|---|
| 16 | KILL ^TMP("XBDH",$J)
|
|---|
| 17 | I '$D(DUZ) W !!,"KERNEL VARIABLES REQUIRED",!!,*7 G EXIT
|
|---|
| 18 | KILL:'$D(XBDHDATA) ^TMP("XBDH",$J)
|
|---|
| 19 | I $P($T(+2^DI),";",3)<17.77 W !!,"SORRY... THIS ROUTINE IS NOT COMPATABLE WITH YOUR VERSION OF FILEMAN" G EXIT
|
|---|
| 20 | S XBDHWOFF=""
|
|---|
| 21 | F %=2,8,15,16 I ^DD("OS")=% S XBDHWOFF="U 0:(0)" Q
|
|---|
| 22 | S IOP=0
|
|---|
| 23 | D ^%ZIS
|
|---|
| 24 | S V="|"
|
|---|
| 25 | ;
|
|---|
| 26 | TITLE ;
|
|---|
| 27 | W @IOF,!,$$C^XBFUNC("***** HEADER LINE PROCESSOR *****"),!,$$C^XBFUNC("Version "_$P($T(XBDH+1),";",3))
|
|---|
| 28 | ;
|
|---|
| 29 | XBDHD ;
|
|---|
| 30 | D ^XBDHD
|
|---|
| 31 | I $D(XBDHQUIT) KILL XBDHQUIT G EXIT
|
|---|
| 32 | D:$D(^TMP("XBDH",$J,"HEADER"))=11 ^XBDHDSV
|
|---|
| 33 | I $D(^TMP("XBDH",$J,"SAVE")) G XBDHD
|
|---|
| 34 | EXIT ;
|
|---|
| 35 | KILL:'$D(XBDHDATA) ^TMP("XBDH",$J)
|
|---|
| 36 | KILL XBDHDATA
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
