XBHFMAN ; IHS/ADC/GTH - HELP FRAME MANUAL (1/2) ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
; Print a help frame manual for an IHS application, using
; OPTION descriptions and HELP FRAME texts in the namespace
; of the application selected from the PACKAGE file.
;
; Information for the title and preface pages, and for
; indexed words, is expected to be in a routine named
; <namespace>HFMN. The title page lines are expected to
; begin at line TITLE+1, and the preface page at PREFACE+1.
; Any words to be indexed are expected to begin at line
; INDEX+1. See routine XBHFMAN2 for an example.
;
; If entered from the top, user is asked for application.
; Entry point EN() must have the namespace of the application
; as the parameter. That allows programmers to create their
; own option and call it, without forcing user to select the
; applcation.
;
D HOME^%ZIS,DT^DICRW
NEW DIR,XBSEL
G EN1
;
EN(XBSEL) ;PEP ----- From application options, with namespace of application.
;
EN1 ;
S DIC=9.4,DIC(0)="AEM",DIC("S")="I ""AB""[$E($P(^(0),U,2))"
I $D(XBSEL) S X=XBSEL,DIC(0)="",D="C" D IX^DIC I 1
E D ^DIC
I Y<1 W !,"^DIC( LOOKUP FAILED." Q
S XBSEL=+Y
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^XBHFMAN",ZTDESC="Help Frame Manual for "_$P(^DIC(9.4,XBSEL,0),U),ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTSAVE("XBSEL")=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
K ;
KILL XB,ZTSK
D ^%ZISC
D END^XBHFMAN1
Q
;
START ;EP ----- From TaskMan.
;
I '$D(ZTQUEUED),'$D(IO("S")) U IO(0) D WAIT^DICD U IO
;
NEW DIWL,DIWR,DIWF,DIRUT
NEW XBBM,XBCHAP,XBCONT,XBSAVX,XBTM,XBTITL,XBPG,XBHDR,XBHDRE,XBHDRO,XBDASH,XBSTRIP,XBNOHDR,XBIENI,XBLEVEL,XBNAME,XBNS
;
KILL ^TMP("XBHFMAN",$J),^UTILITY($J)
;
; S X=$O(^DIC(9.4,XBSEL,22,"B","0.5",0))
; I X S %=0 F S %=$O(^DIC(9.4,XBSEL,22,X,"P",%)) Q:'% S Y=^(%,0) I $L(Y) S ^TMP("XBHFMAN-I",$J,Y)=""
;
; ----- Set namespace and read indexed words into ^TMP("XBHFMAN-I",$J.
S XBNS=$P(^DIC(9.4,XBSEL,0),U,2)
F X=1:1 S Y=$P($T(@"INDX"+X^@(XBNS_"HFMN")),";",3) Q:'$L(Y) S ^TMP("XBHFMAN-I",$J,Y)=""
;
S DIWL=10,DIWR=74,DIWF="W"
S XBBM=IOSL-5,XBTM=6,XBTITL=$P(^DIC(9.4,XBSEL,0),U)_" HELP FRAME MANUAL",XBPG=0,XBHDR="Index",(XBHDRE,XBHDRO)="",XBDASH="",$P(XBDASH,"-",81)="",XBDASH=$E(XBDASH,DIWL,DIWR)
S XBSTRIP=^DD("FUNC",$O(^DD("FUNC","B","STRIPBLANKS",0)),1)
S (XBCHAP,XBLEVEL)=1,(XBCONT,XBHDR,XBPG,XBNOHDR)=0
;
; ----- Set primary menu as chapter 1.
D SETTMP($O(^DIC(19,"B",XBNS_"MENU",0)),"1")
;
S XBNAME=XBNS
F S XBNAME=$O(^DIC(19,"B",XBNAME)) Q:$E(XBNAME,1,$L(XBNS))'=XBNS I '$D(^DIC(19,"AD",$O(^DIC(19,"B",XBNAME,0)))) S ^TMP("XBHFMAN-M",$J,XBNAME)=""
KILL ^TMP("XBHFMAN-M",$J,XBNS_"MENU")
D MENU($O(^DIC(19,"B",XBNS_"MENU",0)))
;
S XBCHAP=1,XBNAME=""
F S XBNAME=$O(^TMP("XBHFMAN-M",$J,XBNAME)) Q:XBNAME="" S XBCHAP=+$P(XBCHAP,".")+1,XBLEVEL=1 D SETTMP($O(^DIC(19,"B",XBNAME,0)),XBCHAP),MENU($O(^DIC(19,"B",XBNAME,0)))
;
U IO
D ^XBHFMAN1
Q
;
;
Q:'$G(I)
NEW X
S X=0,XBLEVEL=XBLEVEL+1
F S X=$O(^DIC(19,I,10,X)) Q:'X S $P(XBCHAP,".",XBLEVEL)=$P(XBCHAP,".",XBLEVEL)+1,Y=+^(X,0) D SETTMP(Y,XBCHAP) I $$DATA(Y,0,4)="M" D MENU(Y) S $P(XBCHAP,".",XBLEVEL)=0,XBLEVEL=XBLEVEL-1
Q
;
DATA(I,N,P) ;
Q $P(^DIC(19,I,N),U,P)
;
;
;
RTRN ;EP ----- If interactive, ask usr to press RETURN.
I IOST["C-",'$D(IO("S")),$$DIR^XBDIR("E","Press RETURN To Continue or ""^"" to exit","","","","",1)
Q
;
SETTMP(I,N) ; ----- Set option IEN and chapter designation into ^TMP.
NEW X,Y
I '$D(ZTQUEUED),'$D(IO("S")) U IO(0) W "." U IO
F %=1:1 I '$P(N,".",%) S N=$P(N,".",1,%-1) Q
S ^(0)=$G(^TMP("XBHFMAN",$J,0))+1
S ^TMP("XBHFMAN",$J,^TMP("XBHFMAN",$J,0))=I_"^"_N
Q
;
XBHFMAN ; IHS/ADC/GTH - HELP FRAME MANUAL (1/2) ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 ; Print a help frame manual for an IHS application, using
+4 ; OPTION descriptions and HELP FRAME texts in the namespace
+5 ; of the application selected from the PACKAGE file.
+6 ;
+7 ; Information for the title and preface pages, and for
+8 ; indexed words, is expected to be in a routine named
+9 ; <namespace>HFMN. The title page lines are expected to
+10 ; begin at line TITLE+1, and the preface page at PREFACE+1.
+11 ; Any words to be indexed are expected to begin at line
+12 ; INDEX+1. See routine XBHFMAN2 for an example.
+13 ;
+14 ; If entered from the top, user is asked for application.
+15 ; Entry point EN() must have the namespace of the application
+16 ; as the parameter. That allows programmers to create their
+17 ; own option and call it, without forcing user to select the
+18 ; applcation.
+19 ;
+20 DO HOME^%ZIS
DO DT^DICRW
+21 NEW DIR,XBSEL
+22 GOTO EN1
+23 ;
EN(XBSEL) ;PEP ----- From application options, with namespace of application.
+1 ;
EN1 ;
+1 SET DIC=9.4
SET DIC(0)="AEM"
SET DIC("S")="I ""AB""[$E($P(^(0),U,2))"
+2 IF $DATA(XBSEL)
SET X=XBSEL
SET DIC(0)=""
SET D="C"
DO IX^DIC
IF 1
+3 IF '$TEST
DO ^DIC
+4 IF Y<1
WRITE !,"^DIC( LOOKUP FAILED."
QUIT
+5 SET XBSEL=+Y
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^XBHFMAN"
SET ZTDESC="Help Frame Manual for "_$PIECE(^DIC(9.4,XBSEL,0),U)
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 DO END^XBHFMAN1
+4 QUIT
+5 ;
START ;EP ----- From TaskMan.
+1 ;
+2 IF '$DATA(ZTQUEUED)
IF '$DATA(IO("S"))
USE IO(0)
DO WAIT^DICD
USE IO
+3 ;
+4 NEW DIWL,DIWR,DIWF,DIRUT
+5 NEW XBBM,XBCHAP,XBCONT,XBSAVX,XBTM,XBTITL,XBPG,XBHDR,XBHDRE,XBHDRO,XBDASH,XBSTRIP,XBNOHDR,XBIENI,XBLEVEL,XBNAME,XBNS
+6 ;
+7 KILL ^TMP("XBHFMAN",$JOB),^UTILITY($JOB)
+8 ;
+9 ; S X=$O(^DIC(9.4,XBSEL,22,"B","0.5",0))
+10 ; I X S %=0 F S %=$O(^DIC(9.4,XBSEL,22,X,"P",%)) Q:'% S Y=^(%,0) I $L(Y) S ^TMP("XBHFMAN-I",$J,Y)=""
+11 ;
+12 ; ----- Set namespace and read indexed words into ^TMP("XBHFMAN-I",$J.
+13 SET XBNS=$PIECE(^DIC(9.4,XBSEL,0),U,2)
+14 FOR X=1:1
SET Y=$PIECE($TEXT(@"INDX"+X^@(XBNS_"HFMN")),";",3)
IF '$LENGTH(Y)
QUIT
SET ^TMP("XBHFMAN-I",$JOB,Y)=""
+15 ;
+16 SET DIWL=10
SET DIWR=74
SET DIWF="W"
+17 SET XBBM=IOSL-5
SET XBTM=6
SET XBTITL=$PIECE(^DIC(9.4,XBSEL,0),U)_" HELP FRAME MANUAL"
SET XBPG=0
SET XBHDR="Index"
SET (XBHDRE,XBHDRO)=""
SET XBDASH=""
SET $PIECE(XBDASH,"-",81)=""
SET XBDASH=$EXTRACT(XBDASH,DIWL,DIWR)
+18 SET XBSTRIP=^DD("FUNC",$ORDER(^DD("FUNC","B","STRIPBLANKS",0)),1)
+19 SET (XBCHAP,XBLEVEL)=1
SET (XBCONT,XBHDR,XBPG,XBNOHDR)=0
+20 ;
+21 ; ----- Set primary menu as chapter 1.
+22 DO SETTMP($ORDER(^DIC(19,"B",XBNS_"MENU",0)),"1")
+23 ;
+24 SET XBNAME=XBNS
+25 FOR
SET XBNAME=$ORDER(^DIC(19,"B",XBNAME))
IF $EXTRACT(XBNAME,1,$LENGTH(XBNS))'=XBNS
QUIT
IF '$DATA(^DIC(19,"AD",$ORDER(^DIC(19,"B",XBNAME,0))))
SET ^TMP("XBHFMAN-M",$JOB,XBNAME)=""
+26 KILL ^TMP("XBHFMAN-M",$JOB,XBNS_"MENU")
+27 DO MENU($ORDER(^DIC(19,"B",XBNS_"MENU",0)))
+28 ;
+29 SET XBCHAP=1
SET XBNAME=""
+30 FOR
SET XBNAME=$ORDER(^TMP("XBHFMAN-M",$JOB,XBNAME))
IF XBNAME=""
QUIT
SET XBCHAP=+$PIECE(XBCHAP,".")+1
SET XBLEVEL=1
DO SETTMP($ORDER(^DIC(19,"B",XBNAME,0)),XBCHAP)
DO MENU($ORDER(^DIC(19,"B",XBNAME,0)))
+31 ;
+32 USE IO
+33 DO ^XBHFMAN1
+34 QUIT
+35 ;
+36 ;
+1 IF '$GET(I)
QUIT
+2 NEW X
+3 SET X=0
SET XBLEVEL=XBLEVEL+1
+4 FOR
SET X=$ORDER(^DIC(19,I,10,X))
IF 'X
QUIT
SET $PIECE(XBCHAP,".",XBLEVEL)=$PIECE(XBCHAP,".",XBLEVEL)+1
SET Y=+^(X,0)
DO SETTMP(Y,XBCHAP)
IF $$DATA(Y,0,4)="M"
DO MENU(Y)
SET $PIECE(XBCHAP,".",XBLEVEL)=0
SET XBLEVEL=XBLEVEL-1
+5 QUIT
+6 ;
DATA(I,N,P) ;
+1 QUIT $PIECE(^DIC(19,I,N),U,P)
+2 ;
+3 ;
+4 ;
RTRN ;EP ----- If interactive, ask usr to press RETURN.
+1 IF IOST["C-"
IF '$DATA(IO("S"))
IF $$DIR^XBDIR("E","Press RETURN To Continue or ""^"" to exit","","","","",1)
+2 QUIT
+3 ;
SETTMP(I,N) ; ----- Set option IEN and chapter designation into ^TMP.
+1 NEW X,Y
+2 IF '$DATA(ZTQUEUED)
IF '$DATA(IO("S"))
USE IO(0)
WRITE "."
USE IO
+3 FOR %=1:1
IF '$PIECE(N,".",%)
SET N=$PIECE(N,".",1,%-1)
QUIT
+4 SET ^(0)=$GET(^TMP("XBHFMAN",$JOB,0))+1
+5 SET ^TMP("XBHFMAN",$JOB,^TMP("XBHFMAN",$JOB,0))=I_"^"_N
+6 QUIT
+7 ;
