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

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

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

File size: 2.3 KB
Line 
1XBHEDD11 ;402,DJB,10/23/91,EDD - Templates and Description
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;;David Bolduc - Togus,ME
4EN ;Templates
5 I '$D(^DIBT("F"_ZNUM)),'$D(^DIPT("F"_ZNUM)),'$D(^DIE("F"_ZNUM)) W ?30,"No Templates" S FLAGG=1 G EX
6 S Z1="" D INIT^XBHEDD7 G:FLAGQ EX D HD
7 D DIPT G:FLAGQ EX D DIBT G:FLAGQ EX D DIE
8EX ;
9 K A,DISYS,DIW,DIWI,DIWTC,DIWX,DIWT,DIWL,DIWF,DIWR,DN,HEAD,II,VAR
10 Q
11DIPT ;Print Templates
12 S HEAD="A.) PRINT TEMPLATES:" W !?2,HEAD
13 S A="",VAR="^DIPT"
14 F II=1:1 S A=$O(^DIPT("F"_ZNUM,A)) Q:A="" W !?12,$J(II,4),". ",A S B=$O(^DIPT("F"_ZNUM,A,"")) W:$D(^DIPT(B,"ROU")) ?60,"Compiled: ",^DIPT(B,"ROU") I $Y>SIZE D PAGE Q:FLAGQ!(Z1="S")
15 I II=1 W ?25,"No print templates..."
16 Q
17DIBT ;Sort Templates
18 S HEAD="B.) SORT TEMPLATES:" W !?2,HEAD
19 S A="",VAR="^DIBT"
20 F II=1:1 S A=$O(^DIBT("F"_ZNUM,A)) Q:A="" W !?12,$J(II,4),". ",A I $Y>SIZE D PAGE Q:FLAGQ!(Z1="S")
21 I II=1 W ?25,"No sort templates..."
22 Q
23DIE ;Edit Templates
24 S HEAD="C.) INPUT TEMPLATES:" W !?2,HEAD
25 S A="",VAR="^DIE"
26 F II=1:1 S A=$O(^DIE("F"_ZNUM,A)) Q:A="" W !?12,$J(II,4),". ",A S B=$O(^DIE("F"_ZNUM,A,"")) W:$D(^DIE(B,"ROU")) ?60,"Compiled: ",^DIE(B,"ROU") I $Y>SIZE D PAGE Q:FLAGQ!(VAR="")
27 I II=1 W ?25,"No input templates..."
28 Q
29PAGE ;Templates
30 I VAR="^DIE" S ZX=VAR_"(""F"_ZNUM_""","""_A_""")" I $O(@ZX)="" S VAR="" Q
31 I FLAGP,IO'=IO(0) W @IOF,!!! D HD Q
32 W !!?2,"<RETURN> to continue, 'S' to skip, '^' to quit, '^^' to exit: "
33 R Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
34 I Z1="S",VAR="^DIE" S FLAGQ=1 Q
35 S ZX=VAR_"(""F"_ZNUM_""","""_A_""")"
36 W @IOF D HD I Z1="S"!($O(@ZX)="") Q
37 W !?2,HEAD," continued..." Q
38PAGE1 ;File Description
39 I FLAGP,IO'=IO(0) W @IOF,!!! D HD1 Q
40 R !!?2,"<RETURN> to continue, '^' to quit, '^' to exit: ",Z1:DTIME
41 S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
42 W @IOF D HD1
43 Q
44DES ;File Description
45 I FLAGP D PRINT^XBHEDD7 ;Shut off printing
46 I '$D(^DIC(ZNUM,"%D")) W ?30,"No description available." S FLAGG=1 Q
47 W @IOF D HD1
48 K ^UTILITY($J,"W")
49 S A=0 F S A=$O(^DIC(ZNUM,"%D",A)) Q:A="" S X=^DIC(ZNUM,"%D",A,0),DIWL=5,DIWR=75,DIWF="W" D ^DIWP I $Y>SIZE D PAGE1 Q:FLAGQ
50 D:'FLAGQ ^DIWW
51 G EX
52HD ;Templates
53 W !?2,"T E M P L A T E S PRINT * SORT * INPUT",!,$E(ZLINE,1,IOM)
54 Q
55HD1 ;File description
56 W !?2,"File description for ",ZNAM," file.",!,$E(ZLINE1,1,IOM)
57 Q
Note: See TracBrowser for help on using the repository browser.