source: IHS-VA_UTILITIES-XB/trunk/XBHEDD11.m@ 1680

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

Modified directory structure; moved routines.

File size: 2.3 KB
RevLine 
[641]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.