Routine: XBHFMAN

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

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

MENU(I) ; ----- Assign chapter number to OPTIONs. Recurse if OPTION is a menu.

 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

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)

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

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      ;

MENU(I)   ; ----- Assign chapter number to OPTIONs. Recurse if OPTION is a menu.

 +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       ;

XBHFMAN.m