source: IHS-VA_UTILITIES-XB/trunk/XBDH.m@ 1745

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

Modified directory structure; moved routines.

File size: 1.1 KB
RevLine 
[641]1XBDH ; 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 ;
14VAR ;
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 ;
26TITLE ;
27 W @IOF,!,$$C^XBFUNC("***** HEADER LINE PROCESSOR *****"),!,$$C^XBFUNC("Version "_$P($T(XBDH+1),";",3))
28 ;
29XBDHD ;
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
34EXIT ;
35 KILL:'$D(XBDHDATA) ^TMP("XBDH",$J)
36 KILL XBDHDATA
37 Q
38 ;
Note: See TracBrowser for help on using the repository browser.