XBHEDD11 ;402,DJB,10/23/91,EDD - Templates and Description
;;2.6;IHS UTILITIES;;JUN 28, 1993
;;David Bolduc - Togus,ME
EN ;Templates
I '$D(^DIBT("F"_ZNUM)),'$D(^DIPT("F"_ZNUM)),'$D(^DIE("F"_ZNUM)) W ?30,"No Templates" S FLAGG=1 G EX
S Z1="" D INIT^XBHEDD7 G:FLAGQ EX D HD
D DIPT G:FLAGQ EX D DIBT G:FLAGQ EX D DIE
EX ;
K A,DISYS,DIW,DIWI,DIWTC,DIWX,DIWT,DIWL,DIWF,DIWR,DN,HEAD,II,VAR
Q
DIPT ;Print Templates
S HEAD="A.) PRINT TEMPLATES:" W !?2,HEAD
S A="",VAR="^DIPT"
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")
I II=1 W ?25,"No print templates..."
Q
DIBT ;Sort Templates
S HEAD="B.) SORT TEMPLATES:" W !?2,HEAD
S A="",VAR="^DIBT"
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")
I II=1 W ?25,"No sort templates..."
Q
DIE ;Edit Templates
S HEAD="C.) INPUT TEMPLATES:" W !?2,HEAD
S A="",VAR="^DIE"
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="")
I II=1 W ?25,"No input templates..."
Q
PAGE ;Templates
I VAR="^DIE" S ZX=VAR_"(""F"_ZNUM_""","""_A_""")" I $O(@ZX)="" S VAR="" Q
I FLAGP,IO'=IO(0) W @IOF,!!! D HD Q
W !!?2,"<RETURN> to continue, 'S' to skip, '^' to quit, '^^' to exit: "
R Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
I Z1="S",VAR="^DIE" S FLAGQ=1 Q
S ZX=VAR_"(""F"_ZNUM_""","""_A_""")"
W @IOF D HD I Z1="S"!($O(@ZX)="") Q
W !?2,HEAD," continued..." Q
PAGE1 ;File Description
I FLAGP,IO'=IO(0) W @IOF,!!! D HD1 Q
R !!?2,"<RETURN> to continue, '^' to quit, '^' to exit: ",Z1:DTIME
S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
W @IOF D HD1
Q
DES ;File Description
I FLAGP D PRINT^XBHEDD7 ;Shut off printing
I '$D(^DIC(ZNUM,"%D")) W ?30,"No description available." S FLAGG=1 Q
W @IOF D HD1
K ^UTILITY($J,"W")
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
D:'FLAGQ ^DIWW
G EX
HD ;Templates
W !?2,"T E M P L A T E S PRINT * SORT * INPUT",!,$E(ZLINE,1,IOM)
Q
HD1 ;File description
W !?2,"File description for ",ZNAM," file.",!,$E(ZLINE1,1,IOM)
Q
XBHEDD11 ;402,DJB,10/23/91,EDD - Templates and Description
+1 ;;2.6;IHS UTILITIES;;JUN 28, 1993
+2 ;;David Bolduc - Togus,ME
EN ;Templates
+1 IF '$DATA(^DIBT("F"_ZNUM))
IF '$DATA(^DIPT("F"_ZNUM))
IF '$DATA(^DIE("F"_ZNUM))
WRITE ?30,"No Templates"
SET FLAGG=1
GOTO EX
+2 SET Z1=""
DO INIT^XBHEDD7
IF FLAGQ
GOTO EX
DO HD
+3 DO DIPT
IF FLAGQ
GOTO EX
DO DIBT
IF FLAGQ
GOTO EX
DO DIE
EX ;
+1 KILL A,DISYS,DIW,DIWI,DIWTC,DIWX,DIWT,DIWL,DIWF,DIWR,DN,HEAD,II,VAR
+2 QUIT
DIPT ;Print Templates
+1 SET HEAD="A.) PRINT TEMPLATES:"
WRITE !?2,HEAD
+2 SET A=""
SET VAR="^DIPT"
+3 FOR II=1:1
SET A=$ORDER(^DIPT("F"_ZNUM,A))
IF A=""
QUIT
WRITE !?12,$JUSTIFY(II,4),". ",A
SET B=$ORDER(^DIPT("F"_ZNUM,A,""))
IF $DATA(^DIPT(B,"ROU"))
WRITE ?60,"Compiled: ",^DIPT(B,"ROU")
IF $Y>SIZE
DO PAGE
IF FLAGQ!(Z1="S")
QUIT
+4 IF II=1
WRITE ?25,"No print templates..."
+5 QUIT
DIBT ;Sort Templates
+1 SET HEAD="B.) SORT TEMPLATES:"
WRITE !?2,HEAD
+2 SET A=""
SET VAR="^DIBT"
+3 FOR II=1:1
SET A=$ORDER(^DIBT("F"_ZNUM,A))
IF A=""
QUIT
WRITE !?12,$JUSTIFY(II,4),". ",A
IF $Y>SIZE
DO PAGE
IF FLAGQ!(Z1="S")
QUIT
+4 IF II=1
WRITE ?25,"No sort templates..."
+5 QUIT
DIE ;Edit Templates
+1 SET HEAD="C.) INPUT TEMPLATES:"
WRITE !?2,HEAD
+2 SET A=""
SET VAR="^DIE"
+3 FOR II=1:1
SET A=$ORDER(^DIE("F"_ZNUM,A))
IF A=""
QUIT
WRITE !?12,$JUSTIFY(II,4),". ",A
SET B=$ORDER(^DIE("F"_ZNUM,A,""))
IF $DATA(^DIE(B,"ROU"))
WRITE ?60,"Compiled: ",^DIE(B,"ROU")
IF $Y>SIZE
DO PAGE
IF FLAGQ!(VAR="")
QUIT
+4 IF II=1
WRITE ?25,"No input templates..."
+5 QUIT
PAGE ;Templates
+1 IF VAR="^DIE"
SET ZX=VAR_"(""F"_ZNUM_""","""_A_""")"
IF $ORDER(@ZX)=""
SET VAR=""
QUIT
+2 IF FLAGP
IF IO'=IO(0)
WRITE @IOF,!!!
DO HD
QUIT
+3 WRITE !!?2,"<RETURN> to continue, 'S' to skip, '^' to quit, '^^' to exit: "
+4 READ Z1:DTIME
IF '$TEST
SET Z1="^"
IF Z1["^"
SET FLAGQ=1
IF Z1="^^"
SET FLAGE=1
QUIT
+5 IF Z1="S"
IF VAR="^DIE"
SET FLAGQ=1
QUIT
+6 SET ZX=VAR_"(""F"_ZNUM_""","""_A_""")"
+7 WRITE @IOF
DO HD
IF Z1="S"!($ORDER(@ZX)="")
QUIT
+8 WRITE !?2,HEAD," continued..."
QUIT
PAGE1 ;File Description
+1 IF FLAGP
IF IO'=IO(0)
WRITE @IOF,!!!
DO HD1
QUIT
+2 READ !!?2,"<RETURN> to continue, '^' to quit, '^' to exit: ",Z1:DTIME
+3 IF '$TEST
SET Z1="^"
IF Z1["^"
SET FLAGQ=1
IF Z1="^^"
SET FLAGE=1
QUIT
+4 WRITE @IOF
DO HD1
+5 QUIT
DES ;File Description
+1 ;Shut off printing
IF FLAGP
DO PRINT^XBHEDD7
+2 IF '$DATA(^DIC(ZNUM,"%D"))
WRITE ?30,"No description available."
SET FLAGG=1
QUIT
+3 WRITE @IOF
DO HD1
+4 KILL ^UTILITY($JOB,"W")
+5 SET A=0
FOR
SET A=$ORDER(^DIC(ZNUM,"%D",A))
IF A=""
QUIT
SET X=^DIC(ZNUM,"%D",A,0)
SET DIWL=5
SET DIWR=75
SET DIWF="W"
DO ^DIWP
IF $Y>SIZE
DO PAGE1
IF FLAGQ
QUIT
+6 IF 'FLAGQ
DO ^DIWW
+7 GOTO EX
HD ;Templates
+1 WRITE !?2,"T E M P L A T E S PRINT * SORT * INPUT",!,$EXTRACT(ZLINE,1,IOM)
+2 QUIT
HD1 ;File description
+1 WRITE !?2,"File description for ",ZNAM," file.",!,$EXTRACT(ZLINE1,1,IOM)
+2 QUIT
