XBTM ; IHS/ADC/GTH - TECH MANUAL : MAIN ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
; This routine, and subsequent routines in the XBTM*
; namespace, produce a technical manual from information
; contained in the package. The manual is approximately 80
; pages. All, or individual chapters can be printed.
;
D HOME^%ZIS,DT^DICRW
NEW DIR,XBSEL
SEL ;
S XBSEL=$$DIR^XBDIR("S^1:only one chapter;A:All chapters","Print 1 chapter, or all? 1/A","1")
S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
I XBSEL S XBSEL=$$DIR^XBDIR("N^1:15:0","Which chapter?","","","","^D CHAPS^XBTM") S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
DEV ;
S %ZIS="OPQ"
D ^%ZIS
I POP S IOP=$I D ^%ZIS G K
G:'$D(IO("Q")) START
KILL IO("Q")
I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
S ZTRTN="START^XBTM",ZTDESC="TECHNICAL MANUAL.",ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTSAVE("XBSEL")=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
K ;
KILL XB,ZTSK
D ^%ZISC
G END
;
START ;EP - TaskMan.
NEW DIWL,DIWR,DIWF,XBBM,XBCONT,XBSAVX,XBTM,XBTITL,XBPG,XBHDR,XBHDRE,XBHDRO,XBDASH
D ^XBKTMP
S DIWL=10,DIWR=74,DIWF="W",XBBM=IOSL-5,XBTM=6,XBTITL="IHS/VA UTILITIES TECHNICAL MANUAL",XBPG=0,XBHDR="Index",(XBHDRE,XBHDRO)="",XBDASH="",$P(XBDASH,"-",81)="",XBDASH=$E(XBDASH,DIWL,DIWR)
U IO
I 'XBSEL D ^XBTMI S DIWF="WN" D ^XBTMTI W @IOF S DIWF="W" D ^XBTMPR W @IOF
BODY ;
S (XBCONT,XBHDR,XBPG)=0
KILL ^TMP("XBTM-CONTENTS",$J)
I XBSEL S XBCHAP=XBSEL D MAKEHDRS,TOF Q:$D(DUOUT) D HDR(XBCHAP),@("^XBTM"_XBCHAP) G END
F XBCHAP=1:1:15 D MAKEHDRS,TOF Q:$D(DUOUT) D HDR(XBCHAP),@("^XBTM"_XBCHAP)
;
INDEX ;
S XBHDR="Index"
D TOF
G:$D(DUOUT) HAT
W !!!
S X="|NOWRAP||SETTAB(""C"")||TAB|INDEX"
D ^DIWP,^DIWW
W !!!
D CONT("INDEX^^"_XBPG)
S (XB,XBCONT)="",$P(XBCONT,".",81)=""
F S XB=$O(^TMP("XBTM-INDEX",$J,XB)) Q:XB="" Q:$D(DUOUT) S X="" D
.F XBX=0:0 S XBX=$O(^TMP("XBTM-INDEX",$J,XB,XBX)) Q:$D(DUOUT) S X=X_XBX_"," I '$O(^(XBX)) D Q
..S X=XB_$E(XBCONT,1,DIWR-DIWL-$L(XB)-$L(X))_$E(X,1,$L(X)-1)
..S XBSAVX=X
..F S X=$E(XBSAVX,1,DIWR-DIWL),XBSAVX=$E(XBSAVX,DIWR-DIWL+1,$L(XBSAVX)) Q:'$L(X) D TOF:$Y>XBBM Q:$D(DUOUT) D ^DIWP
..Q
.Q
D ^DIWW,PAUSE^XB
G:$D(DUOUT) HAT
;
CONTENTS ;
W @IOF,!!!!!
S X="|SETTAB(""C"")||TAB|CONTENTS"
D ^DIWP,^DIWW
W !!
S XB=0
F S XB=$O(^TMP("XBTM-CONTENTS",$J,XB)) Q:'+XB S X=^(XB),X=$P(X,U)_" "_$P(X,U,2)_$E(XBCONT,1,DIWR-DIWL-$L(X)+1)_$P(X,U,3) D TOF:$Y>XBBM Q:$D(DUOUT) D ^DIWP
G:$D(DUOUT) HAT
D ^DIWW,PAUSE^XB
G:$D(DUOUT) HAT
END ;
D PAUSE^XB
G:$D(DUOUT) HAT
W @IOF
HAT ;
D ^%ZISC
KILL XB,XBBM,XBCHAP,XBCONT,XBODD,XBHDR,XBIEN,XBPARA,XBPG,XBROOT,XBTITL,XBTM,XBX,XBY,DIC,DIWF,DIWL,DIWR
D ^XBKTMP
Q
;
TEXT(XBLAB) ;
F XB=1:1 S X=$P($T(@XBLAB+XB),";;",2) Q:X="###" D PR(X) Q:$D(DUOUT)
Q:$D(DUOUT)
D ^DIWW
Q
;
PR(X) ;EP
I X="|TOP|" D TOF Q
D INDX(X),^DIWP,TOF:$Y>XBBM
Q
;
INDX(X) ;
Q:'$D(XBPG)
S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S %=""
F S %=$O(^TMP("XBTM-I",$J,%)) Q:'$L(%) I $F(X,%) S ^TMP("XBTM-INDEX",$J,%,XBPG)=""
Q
;
HDR(XB) ;
F X="|SETTAB(""C"")||TAB|Chapter "_XB,"|SETTAB(""C"")||TAB|"_$P($T(@XB),";",3) D ^DIWP
W !!
D CONT(XB_U_$P($T(@XB),";",3)_U_XBPG)
Q
;
TOF ;EP
F Q:$Y>XBBM W !
I XBPG>0 W !?(DIWL-1),XBDASH,!,?$S(XBODD:DIWR-$L(XBTITL),1:DIWL-1),XBTITL
D PAUSE^XB
Q:$D(DUOUT)
W @IOF
S XBPG=XBPG+1,XBODD=XBPG#2
F Q:$Y=(XBTM-2) W !
W ?$S(XBODD:DIWR-$L("Page "_XBPG),1:DIWL-1),"Page ",XBPG
I '(XBHDR="Index") W !?DIWL-1,$S(XBODD:XBHDRO,1:XBHDRE)
W !?(DIWL-1),XBDASH,!!
Q
;
MAKEHDRS ;
S (XBHDRE,XBHDRO)=$P($T(@XBCHAP),";",3)
S XBHDRO=XBHDRO_$J("",DIWR-DIWL-$L(XBHDRO)-$L("Chapter "_XBCHAP)+1)_"Chapter "_XBCHAP
S XBHDRE="Chapter "_XBCHAP_$J("",DIWR-DIWL-$L(XBHDRE)-$L("Chapter "_XBCHAP)+1)_XBHDRE
Q
;
CONT(X) ;
S XBCONT=XBCONT+1,^TMP("XBTM-CONTENTS",$J,XBCONT)=X
Q
;
CHAPS ;EP - From DIR
F %=1:1:15 W !?3,$J(%,2),". ",$P($T(@%),";",3)
Q
1 ;;Facility Parameters
2 ;;Area Office Parameters
3 ;;Security Keys
4 ;;Options
5 ;;Fields in Files
6 ;;Archiving and Purging
7 ;;Callable Routines
8 ;;External Relations
9 ;;Internal Relations
10 ;;How to Generate On-Line Documentation
11 ;;Glossary
12 ;;System Requirements
13 ;;Installation notes
14 ;;Enhancements
15 ;;KILL of Unsubscripted Globals
XBTM ; IHS/ADC/GTH - TECH MANUAL : MAIN ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 ; This routine, and subsequent routines in the XBTM*
+4 ; namespace, produce a technical manual from information
+5 ; contained in the package. The manual is approximately 80
+6 ; pages. All, or individual chapters can be printed.
+7 ;
+8 DO HOME^%ZIS
DO DT^DICRW
+9 NEW DIR,XBSEL
SEL ;
+1 SET XBSEL=$$DIR^XBDIR("S^1:only one chapter;A:All chapters","Print 1 chapter, or all? 1/A","1")
+2 IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 IF XBSEL
SET XBSEL=$$DIR^XBDIR("N^1:15:0","Which chapter?","","","","^D CHAPS^XBTM")
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF $DATA(DIRUT)
QUIT
DEV ;
+1 SET %ZIS="OPQ"
+2 DO ^%ZIS
+3 IF POP
SET IOP=$IO
DO ^%ZIS
GOTO K
+4 IF '$DATA(IO("Q"))
GOTO START
+5 KILL IO("Q")
+6 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+7 SET ZTRTN="START^XBTM"
SET ZTDESC="TECHNICAL MANUAL."
SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
SET ZTSAVE("XBSEL")=""
+8 DO ^%ZTLOAD
+9 IF '$DATA(ZTSK)
GOTO DEV
K ;
+1 KILL XB,ZTSK
+2 DO ^%ZISC
+3 GOTO END
+4 ;
START ;EP - TaskMan.
+1 NEW DIWL,DIWR,DIWF,XBBM,XBCONT,XBSAVX,XBTM,XBTITL,XBPG,XBHDR,XBHDRE,XBHDRO,XBDASH
+2 DO ^XBKTMP
+3 SET DIWL=10
SET DIWR=74
SET DIWF="W"
SET XBBM=IOSL-5
SET XBTM=6
SET XBTITL="IHS/VA UTILITIES TECHNICAL MANUAL"
SET XBPG=0
SET XBHDR="Index"
SET (XBHDRE,XBHDRO)=""
SET XBDASH=""
SET $PIECE(XBDASH,"-",81)=""
SET XBDASH=$EXTRACT(XBDASH,DIWL,DIWR)
+4 USE IO
+5 IF 'XBSEL
DO ^XBTMI
SET DIWF="WN"
DO ^XBTMTI
WRITE @IOF
SET DIWF="W"
DO ^XBTMPR
WRITE @IOF
BODY ;
+1 SET (XBCONT,XBHDR,XBPG)=0
+2 KILL ^TMP("XBTM-CONTENTS",$JOB)
+3 IF XBSEL
SET XBCHAP=XBSEL
DO MAKEHDRS
DO TOF
IF $DATA(DUOUT)
QUIT
DO HDR(XBCHAP)
DO @("^XBTM"_XBCHAP)
GOTO END
+4 FOR XBCHAP=1:1:15
DO MAKEHDRS
DO TOF
IF $DATA(DUOUT)
QUIT
DO HDR(XBCHAP)
DO @("^XBTM"_XBCHAP)
+5 ;
INDEX ;
+1 SET XBHDR="Index"
+2 DO TOF
+3 IF $DATA(DUOUT)
GOTO HAT
+4 WRITE !!!
+5 SET X="|NOWRAP||SETTAB(""C"")||TAB|INDEX"
+6 DO ^DIWP
DO ^DIWW
+7 WRITE !!!
+8 DO CONT("INDEX^^"_XBPG)
+9 SET (XB,XBCONT)=""
SET $PIECE(XBCONT,".",81)=""
+10 FOR
SET XB=$ORDER(^TMP("XBTM-INDEX",$JOB,XB))
IF XB=""
QUIT
IF $DATA(DUOUT)
QUIT
SET X=""
Begin DoDot:1
+11 FOR XBX=0:0
SET XBX=$ORDER(^TMP("XBTM-INDEX",$JOB,XB,XBX))
IF $DATA(DUOUT)
QUIT
SET X=X_XBX_","
IF '$ORDER(^(XBX))
Begin DoDot:2
+12 SET X=XB_$EXTRACT(XBCONT,1,DIWR-DIWL-$LENGTH(XB)-$LENGTH(X))_$EXTRACT(X,1,$LENGTH(X)-1)
+13 SET XBSAVX=X
+14 FOR
SET X=$EXTRACT(XBSAVX,1,DIWR-DIWL)
SET XBSAVX=$EXTRACT(XBSAVX,DIWR-DIWL+1,$LENGTH(XBSAVX))
IF '$LENGTH(X)
QUIT
IF $Y>XBBM
DO TOF
IF $DATA(DUOUT)
QUIT
DO ^DIWP
+15 QUIT
End DoDot:2
QUIT
+16 QUIT
End DoDot:1
+17 DO ^DIWW
DO PAUSE^XB
+18 IF $DATA(DUOUT)
GOTO HAT
+19 ;
CONTENTS ;
+1 WRITE @IOF,!!!!!
+2 SET X="|SETTAB(""C"")||TAB|CONTENTS"
+3 DO ^DIWP
DO ^DIWW
+4 WRITE !!
+5 SET XB=0
+6 FOR
SET XB=$ORDER(^TMP("XBTM-CONTENTS",$JOB,XB))
IF '+XB
QUIT
SET X=^(XB)
SET X=$PIECE(X,U)_" "_$PIECE(X,U,2)_$EXTRACT(XBCONT,1,DIWR-DIWL-$LENGTH(X)+1)_$PIECE(X,U,3)
IF $Y>XBBM
DO TOF
IF $DATA(DUOUT)
QUIT
DO ^DIWP
+7 IF $DATA(DUOUT)
GOTO HAT
+8 DO ^DIWW
DO PAUSE^XB
+9 IF $DATA(DUOUT)
GOTO HAT
END ;
+1 DO PAUSE^XB
+2 IF $DATA(DUOUT)
GOTO HAT
+3 WRITE @IOF
HAT ;
+1 DO ^%ZISC
+2 KILL XB,XBBM,XBCHAP,XBCONT,XBODD,XBHDR,XBIEN,XBPARA,XBPG,XBROOT,XBTITL,XBTM,XBX,XBY,DIC,DIWF,DIWL,DIWR
+3 DO ^XBKTMP
+4 QUIT
+5 ;
TEXT(XBLAB) ;
+1 FOR XB=1:1
SET X=$PIECE($TEXT(@XBLAB+XB),";;",2)
IF X="###"
QUIT
DO PR(X)
IF $DATA(DUOUT)
QUIT
+2 IF $DATA(DUOUT)
QUIT
+3 DO ^DIWW
+4 QUIT
+5 ;
PR(X) ;EP
+1 IF X="|TOP|"
DO TOF
QUIT
+2 DO INDX(X)
DO ^DIWP
IF $Y>XBBM
DO TOF
+3 QUIT
+4 ;
INDX(X) ;
+1 IF '$DATA(XBPG)
QUIT
+2 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+3 SET %=""
+4 FOR
SET %=$ORDER(^TMP("XBTM-I",$JOB,%))
IF '$LENGTH(%)
QUIT
IF $FIND(X,%)
SET ^TMP("XBTM-INDEX",$JOB,%,XBPG)=""
+5 QUIT
+6 ;
HDR(XB) ;
+1 FOR X="|SETTAB(""C"")||TAB|Chapter "_XB,"|SETTAB(""C"")||TAB|"_$PIECE($TEXT(@XB),";",3)
DO ^DIWP
+2 WRITE !!
+3 DO CONT(XB_U_$PIECE($TEXT(@XB),";",3)_U_XBPG)
+4 QUIT
+5 ;
TOF ;EP
+1 FOR
IF $Y>XBBM
QUIT
WRITE !
+2 IF XBPG>0
WRITE !?(DIWL-1),XBDASH,!,?$SELECT(XBODD:DIWR-$LENGTH(XBTITL),1:DIWL-1),XBTITL
+3 DO PAUSE^XB
+4 IF $DATA(DUOUT)
QUIT
+5 WRITE @IOF
+6 SET XBPG=XBPG+1
SET XBODD=XBPG#2
+7 FOR
IF $Y=(XBTM-2)
QUIT
WRITE !
+8 WRITE ?$SELECT(XBODD:DIWR-$LENGTH("Page "_XBPG),1:DIWL-1),"Page ",XBPG
+9 IF '(XBHDR="Index")
WRITE !?DIWL-1,$SELECT(XBODD:XBHDRO,1:XBHDRE)
+10 WRITE !?(DIWL-1),XBDASH,!!
+11 QUIT
+12 ;
MAKEHDRS ;
+1 SET (XBHDRE,XBHDRO)=$PIECE($TEXT(@XBCHAP),";",3)
+2 SET XBHDRO=XBHDRO_$JUSTIFY("",DIWR-DIWL-$LENGTH(XBHDRO)-$LENGTH("Chapter "_XBCHAP)+1)_"Chapter "_XBCHAP
+3 SET XBHDRE="Chapter "_XBCHAP_$JUSTIFY("",DIWR-DIWL-$LENGTH(XBHDRE)-$LENGTH("Chapter "_XBCHAP)+1)_XBHDRE
+4 QUIT
+5 ;
CONT(X) ;
+1 SET XBCONT=XBCONT+1
SET ^TMP("XBTM-CONTENTS",$JOB,XBCONT)=X
+2 QUIT
+3 ;
CHAPS ;EP - From DIR
+1 FOR %=1:1:15
WRITE !?3,$JUSTIFY(%,2),". ",$PIECE($TEXT(@%),";",3)
+2 QUIT
1 ;;Facility Parameters
2 ;;Area Office Parameters
3 ;;Security Keys
4 ;;Options
5 ;;Fields in Files
6 ;;Archiving and Purging
7 ;;Callable Routines
8 ;;External Relations
9 ;;Internal Relations
10 ;;How to Generate On-Line Documentation
11 ;;Glossary
12 ;;System Requirements
13 ;;Installation notes
14 ;;Enhancements
15 ;;KILL of Unsubscripted Globals
