Routine: XBDH

XBDH ; IHS/ADC/GTH - HEADER EDITOR MAIN ROUTINE ; [ 02/07/97   3:02 PM ]

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

 ; Thanks to Dr. Dave Grau, OHPRD/TUCSON, for the original

 ; routine.

 ; THIS ROUTINE IS DEDICATED TO MY FRIEND AND MENTOR,

 ; KEN FLESHMAN M.D.

 ; Version 11.1 is dedicated to Maureen Hoye and Tami Winn

 ; who made it possible to create a "legal", distributable

 ; package.  Sincere thanks!!!

VAR ;

 NEW XBDHMORE,DHD,V,X,Y,XBDHPDFN,XBDHPDNA,XBDHTHLW,XBDHL,XBDHI,%Y,%,A,C,Z,I,XBDHMFLG,XBDHWOFF

 KILL ^TMP("XBDH",$J)

 I '$D(DUZ) W !!,"KERNEL VARIABLES REQUIRED",!!,*7 G EXIT

 KILL:'$D(XBDHDATA) ^TMP("XBDH",$J)

 I $P($T(+2^DI),";",3)<17.77 W !!,"SORRY... THIS ROUTINE IS NOT COMPATABLE WITH YOUR VERSION OF FILEMAN" G EXIT

 S XBDHWOFF=""

 F %=2,8,15,16 I ^DD("OS")=% S XBDHWOFF="U 0:(0)" Q

 S IOP=0

 D ^%ZIS

 S V="|"

TITLE ;

 W @IOF,!,$$C^XBFUNC("*****  HEADER LINE PROCESSOR  *****"),!,$$C^XBFUNC("Version "_$P($T(XBDH+1),";",3))

XBDHD ;

 D ^XBDHD

 I $D(XBDHQUIT) KILL XBDHQUIT G EXIT

 D:$D(^TMP("XBDH",$J,"HEADER"))=11 ^XBDHDSV

 I $D(^TMP("XBDH",$J,"SAVE")) G XBDHD

EXIT ;

 KILL:'$D(XBDHDATA) ^TMP("XBDH",$J)

 KILL XBDHDATA

XBDH      ; IHS/ADC/GTH - HEADER EDITOR MAIN ROUTINE ; [ 02/07/97   3:02 PM ]

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

 +2       ;

 +3       ; Thanks to Dr. Dave Grau, OHPRD/TUCSON, for the original

 +4       ; routine.

 +5       ;

 +6       ; THIS ROUTINE IS DEDICATED TO MY FRIEND AND MENTOR,

 +7       ; KEN FLESHMAN M.D.

 +8       ;

 +9       ; Version 11.1 is dedicated to Maureen Hoye and Tami Winn

 +10      ; who made it possible to create a "legal", distributable

 +11      ; package.  Sincere thanks!!!

 +12      ;

VAR       ;

 +1        NEW XBDHMORE,DHD,V,X,Y,XBDHPDFN,XBDHPDNA,XBDHTHLW,XBDHL,XBDHI,%Y,%,A,C,Z,I,XBDHMFLG,XBDHWOFF

 +2        KILL ^TMP("XBDH",$JOB)

 +3        IF '$DATA(DUZ)

               WRITE !!,"KERNEL VARIABLES REQUIRED",!!,*7

               GOTO EXIT

 +4        IF '$DATA(XBDHDATA)

               KILL ^TMP("XBDH",$JOB)

 +5        IF $PIECE($TEXT(+2^DI),";",3)<17.77

               WRITE !!,"SORRY... THIS ROUTINE IS NOT COMPATABLE WITH YOUR VERSION OF FILEMAN"

               GOTO EXIT

 +6        SET XBDHWOFF=""

 +7        FOR %=2,8,15,16

               IF ^DD("OS")=%

                   SET XBDHWOFF="U 0:(0)"

                   QUIT

 +8        SET IOP=0

 +9        DO ^%ZIS

 +10       SET V="|"

 +11      ;

TITLE     ;

 +1        WRITE @IOF,!,$$C^XBFUNC("*****  HEADER LINE PROCESSOR  *****"),!,$$C^XBFUNC("Version "_$PIECE($TEXT(XBDH+1),";",3))

 +2       ;

XBDHD     ;

 +1        DO ^XBDHD

 +2        IF $DATA(XBDHQUIT)

               KILL XBDHQUIT

               GOTO EXIT

 +3        IF $DATA(^TMP("XBDH",$JOB,"HEADER"))=11

               DO ^XBDHDSV

 +4        IF $DATA(^TMP("XBDH",$JOB,"SAVE"))

               GOTO XBDHD

EXIT      ;

 +1        IF '$DATA(XBDHDATA)

               KILL ^TMP("XBDH",$JOB)

 +2        KILL XBDHDATA

 +3        QUIT

 +4       ;

XBDH.m