XBDR.m

XBDR ; IHS/ADC/GTH - BUILDS DIR STRING ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 ; This routine builds a string which sets variable DIR, and

 ; it's descendants, for use in a routine.  The string is

 ; stored in the variable "%", and in the "Temp" storage

 ; area for the screen editor for the current device.

 ;

START ;

 NEW XBDRQUIT,DIR,XBDRMIN,XBDRMAX,XBDRSPEC,X,Y,V,XBDRCODE,XBDRDIR,XBDRDIRA,XBDRDIRB,XBDRRUN,XBDRTYPE,I,Z,DIROUT,DUOUT,DTOUT,DIRUT,XBDRDQ,XBDRDQQ,XBDROUT

RUN ;

 F XBDRRUN=1:1:8 D @$P("LOC,NAR,DFLT,^XBDR1,HELP,SET,TEST,SAVE",",",XBDRRUN) I $D(XBDRQUIT) Q

EXIT ;

 Q

 ;

LOC ;

 S V="|",U="^"

 S XBDROUT="I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))"

 I '$D(DT) S X="T" D ^%DT S DT=Y KILL %DT

 I '$D(DTIME) S DTIME=9999

 I $D(IOM),$D(IOF),$D(IOST),$D(IOSL) Q

 D HOME^%ZIS

 KILL IOPAR,IOT,IOBS,POP

 Q

 ;

HELP ;

 W !!,"The current HELP text is:  "

 S X=$E(XBDRTYPE)_1,X=$T(@X^DIR2),X=$P(X,";",4)

 W """",X,""""

 S DIR("A")="Additional HELP text",DIR(0)="FO^1:199"

 D ^DIR

 KILL DIR

 X XBDROUT

 I  S XBDRQUIT="" Q

 S XBDRDQ=X

 W !

 I '$D(^DIC(9.2)) Q

QQ ;

 S DIC("A")="Enter HELP FRAME name: ",DIC(0)="AEQ",DIC=9.2

 D ^DIC

 KILL DIC

 X XBDROUT

 I  S XBDRQUIT="" Q

 I Y=-1 Q

 S XBDRDQQ=$P(Y,U,2)

 Q

 ;

SET ;

 S XBDRDIR=XBDRTYPE,Y=""

 F I=1:1:3 S X="XBDR"_$P("MIN,MAX,SPEC",",",I) I $D(@X) S $P(Y,":",I)=@X

 I Y]"" S XBDRDIR=XBDRDIR_U_Y

S1 ;

 S XBDRCODE="S DIR(0)="""_XBDRDIR_""""

 I $D(XBDRDIRA) S:XBDRTYPE["F"!($E(XBDRTYPE)) XBDRDIRA=XBDRDIRA S XBDRCODE=XBDRCODE_",DIR(""A"")="""_XBDRDIRA_""""

 I $D(XBDRDIRB) S XBDRCODE=XBDRCODE_",DIR(""B"")="""_XBDRDIRB_""""

 I $D(XBDRDQ),XBDRDQ]"" S XBDRCODE=XBDRCODE_",DIR(""?"")="""_XBDRDQ_""""

 I $D(XBDRDQQ),XBDRDQQ]"" S XBDRCODE=XBDRCODE_",DIR(""??"")="""_XBDRDQQ_""""

 S XBDRCODE=XBDRCODE_" KILL DA D ^DIR KILL DIR"

 Q

 ;

NAR ;

 S DIR("A")="Enter query narrative",DIR(0)="FO"

 D ^DIR

 KILL DIR

 I X="" Q

 X XBDROUT

 I  S XBDRQUIT="" Q

 S XBDRDIRA=X

 Q

 ;

DFLT ;

 S DIR("A")="Enter default value",DIR(0)="FO"

 D ^DIR

 KILL DIR

 I X="" Q

 X XBDROUT

 I  S XBDRQUIT="" Q

 S XBDRDIRB=X

 Q

 ;

TEST ;

 W !!!!!?30,"*****  TEST  *****"

TQ ;

 X XBDRCODE

 I X=U Q

 G TQ

 ;

SAVE ;

 S %=" "_XBDRCODE

 W !!!,"Saving the following line of code in the '%' variable:",!,%,!!

 D SV(%)

 Q

 ;

SV(%) ;

 NEW (%)

 D SAVE^ZIBDR(%)

 Q

 ;

XBDR      ; IHS/ADC/GTH - BUILDS DIR STRING ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ; This routine builds a string which sets variable DIR, and

 +4       ; it's descendants, for use in a routine.  The string is

 +5       ; stored in the variable "%", and in the "Temp" storage

 +6       ; area for the screen editor for the current device.

 +7       ;

START     ;

 +1        NEW XBDRQUIT,DIR,XBDRMIN,XBDRMAX,XBDRSPEC,X,Y,V,XBDRCODE,XBDRDIR,XBDRDIRA,XBDRDIRB,XBDRRUN,XBDRTYPE,I,Z,DIROUT,DUOUT,DTOUT,DIRUT,XBDRDQ,XBDRDQQ,XBDROUT

RUN       ;

 +1        FOR XBDRRUN=1:1:8

               DO @$PIECE("LOC,NAR,DFLT,^XBDR1,HELP,SET,TEST,SAVE",",",XBDRRUN)

               IF $DATA(XBDRQUIT)

                   QUIT 

EXIT      ;

 +1        QUIT 

 +2       ;

LOC       ;

 +1        SET V="|"

           SET U="^"

 +2        SET XBDROUT="I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))"

 +3        IF '$DATA(DT)

               SET X="T"

               DO ^%DT

               SET DT=Y

               KILL %DT

 +4        IF '$DATA(DTIME)

               SET DTIME=9999

 +5        IF $DATA(IOM)

               IF $DATA(IOF)

                   IF $DATA(IOST)

                       IF $DATA(IOSL)

                           QUIT 

 +6        DO HOME^%ZIS

 +7        KILL IOPAR,IOT,IOBS,POP

 +8        QUIT 

 +9       ;

HELP      ;

 +1        WRITE !!,"The current HELP text is:  "

 +2        SET X=$EXTRACT(XBDRTYPE)_1

           SET X=$TEXT(@X^DIR2)

           SET X=$PIECE(X,";",4)

 +3        WRITE """",X,""""

 +4        SET DIR("A")="Additional HELP text"

           SET DIR(0)="FO^1:199"

 +5        DO ^DIR

 +6        KILL DIR

 +7        XECUTE XBDROUT

 +8       IF $TEST

               SET XBDRQUIT=""

               QUIT 

 +9        SET XBDRDQ=X

 +10       WRITE !

 +11       IF '$DATA(^DIC(9.2))

               QUIT 

QQ        ;

 +1        SET DIC("A")="Enter HELP FRAME name: "

           SET DIC(0)="AEQ"

           SET DIC=9.2

 +2        DO ^DIC

 +3        KILL DIC

 +4        XECUTE XBDROUT

 +5       IF $TEST

               SET XBDRQUIT=""

               QUIT 

 +6        IF Y=-1

               QUIT 

 +7        SET XBDRDQQ=$PIECE(Y,U,2)

 +8        QUIT 

 +9       ;

SET       ;

 +1        SET XBDRDIR=XBDRTYPE

           SET Y=""

 +2        FOR I=1:1:3

               SET X="XBDR"_$PIECE("MIN,MAX,SPEC",",",I)

               IF $DATA(@X)

                   SET $PIECE(Y,":",I)=@X

 +3        IF Y]""

               SET XBDRDIR=XBDRDIR_U_Y

S1        ;

 +1        SET XBDRCODE="S DIR(0)="""_XBDRDIR_""""

 +2        IF $DATA(XBDRDIRA)

               IF XBDRTYPE["F"!($EXTRACT(XBDRTYPE))

                   SET XBDRDIRA=XBDRDIRA

               SET XBDRCODE=XBDRCODE_",DIR(""A"")="""_XBDRDIRA_""""

 +3        IF $DATA(XBDRDIRB)

               SET XBDRCODE=XBDRCODE_",DIR(""B"")="""_XBDRDIRB_""""

 +4        IF $DATA(XBDRDQ)

               IF XBDRDQ]""

                   SET XBDRCODE=XBDRCODE_",DIR(""?"")="""_XBDRDQ_""""

 +5        IF $DATA(XBDRDQQ)

               IF XBDRDQQ]""

                   SET XBDRCODE=XBDRCODE_",DIR(""??"")="""_XBDRDQQ_""""

 +6        SET XBDRCODE=XBDRCODE_" KILL DA D ^DIR KILL DIR"

 +7        QUIT 

 +8       ;

NAR       ;

 +1        SET DIR("A")="Enter query narrative"

           SET DIR(0)="FO"

 +2        DO ^DIR

 +3        KILL DIR

 +4        IF X=""

               QUIT 

 +5        XECUTE XBDROUT

 +6       IF $TEST

               SET XBDRQUIT=""

               QUIT 

 +7        SET XBDRDIRA=X

 +8        QUIT 

 +9       ;

DFLT      ;

 +1        SET DIR("A")="Enter default value"

           SET DIR(0)="FO"

 +2        DO ^DIR

 +3        KILL DIR

 +4        IF X=""

               QUIT 

 +5        XECUTE XBDROUT

 +6       IF $TEST

               SET XBDRQUIT=""

               QUIT 

 +7        SET XBDRDIRB=X

 +8        QUIT 

 +9       ;

TEST      ;

 +1        WRITE !!!!!?30,"*****  TEST  *****"

TQ        ;

 +1        XECUTE XBDRCODE

 +2        IF X=U

               QUIT 

 +3        GOTO TQ

 +4       ;

SAVE      ;

 +1        SET %=" "_XBDRCODE

 +2        WRITE !!!,"Saving the following line of code in the '%' variable:",!,%,!!

 +3        DO SV(%)

 +4        QUIT 

 +5       ;

SV(%)     ;

 +1        NEW (%)

 +2        DO SAVE^ZIBDR(%)

 +3        QUIT 

 +4       ;