- 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
