[641] | 1 | XBHEDD11 ;402,DJB,10/23/91,EDD - Templates and Description
|
---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
---|
| 3 | ;;David Bolduc - Togus,ME
|
---|
| 4 | EN ;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
|
---|
| 8 | EX ;
|
---|
| 9 | K A,DISYS,DIW,DIWI,DIWTC,DIWX,DIWT,DIWL,DIWF,DIWR,DN,HEAD,II,VAR
|
---|
| 10 | Q
|
---|
| 11 | DIPT ;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
|
---|
| 17 | DIBT ;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
|
---|
| 23 | DIE ;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
|
---|
| 29 | PAGE ;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
|
---|
| 38 | PAGE1 ;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
|
---|
| 44 | DES ;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
|
---|
| 52 | HD ;Templates
|
---|
| 53 | W !?2,"T E M P L A T E S PRINT * SORT * INPUT",!,$E(ZLINE,1,IOM)
|
---|
| 54 | Q
|
---|
| 55 | HD1 ;File description
|
---|
| 56 | W !?2,"File description for ",ZNAM," file.",!,$E(ZLINE1,1,IOM)
|
---|
| 57 | Q
|
---|