XBLFD.m

XBLFD ;IHS/SET/GTH - LISTS FILE DESCRIPTIONS ; [ 04/18/2003  9:05 AM ]

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

 ;IHS/SET/GTH XB*3*9 10/29/2002  New routine.

 ; This routine lists the number, name, global, and, optionally,

 ; description <if any> of the selected file(s).

 ;

START ;

 ; --- Display routine description.

 D HOME^%ZIS,DT^DICRW

 KILL ^UTILITY($J)

 S ^UTILITY($J,"XBLFD")=""

 D EN^XBRPTL

 KILL ^UTILITY($J)

 NEW QFLG,XBDESC

 S QFLG=0

 ; --- Get file(s).

 D ^XBDSET

 Q:'$D(^UTILITY("XBDSET",$J))

 ; --- Print DESCRIPTION flag.

 S XBDESC=$$DIR^XBDIR("Y","Print file DESCRIPTION ","Y",$G(DTIME,500),"You can include the DESCRIPTION of the file in your list")

 Q:Y="^"

 I XBDESC NEW DIWL,DIWR,DIWF S DIWL=14,DIWR=74,DIWF="W"

 ; --- Select device.

 W !

 S %ZIS="Q",ZTSAVE("^UTILITY(""XBDSET"",$J,")=""

 D EN^XUTMDEVQ("EN^XBLFD","List File Descriptions.",.ZTSAVE,.%ZIS)

 D EN^XBVK("ZT")

 Q

 ;

EN ;PEP - List 0th node of pre-selected list of FileMan files.

 ; IOF,IOSL must be set and U IO if appropriate.

 I $D(IOF)#2,$D(IOSL)#2

 E  Q

 NEW F,G,N,X,QFLG

 ; F:File #; G:Global; N:Zeroth

 S QFLG=0

 D HEADER

 S F=0

 F  S F=$O(^UTILITY("XBDSET",$J,F)) Q:F'=+F  S G=$$FGLOB^XBFUNC(F) I G'=-1 D LIST Q:QFLG

 D ^%ZISC

 Q

 ;

LIST ;

 D:$Y>(IOSL-3) PAGE

 Q:QFLG

 W F,?13,$$FNAME^XBFUNC(F),?60,G,!

 I XBDESC D DESC(F)

 Q

 ;

DESC(F) ; Print file DESCRIPTION.

 NEW XB

 F XB=0:0 S XB=$O(^DIC(F,"%D",XB)) Q:'XB  S X=$G(^(XB,0)) D ^DIWP I $Y>(IOSL-3) D PAGE Q:QFLG

 Q:QFLG

 D ^DIWW

 Q

 ;

PAGE ; PAGE BREAK

 NEW F,G,N,X

 I IO=IO(0),$E(IOST,1,2)="C-" S Y=$$DIR^XBDIR("E") S:$D(DIRUT)!($D(DUOUT)) QFLG=1 KILL DIRUT,DUOUT

 Q:QFLG

 D HEADER

 Q

 ;

HEADER ; PRINT HEADER

 W @IOF,$$FMTE^XLFDT($$NOW^XLFDT),?34,"FILE DESCRIPTIONS"

 X ^%ZOSF("UCI")

 W ?65,$P(Y," ",1),!,$$REPEAT^XLFSTR("-",IOM),!,"NUMBER",?13,"FILE",?60,"GLOBAL",!

 I XBDESC W ?13,"<DESCRIPTION>",!

 W $$REPEAT^XLFSTR("-",IOM),!!

 Q

 ;

XBLFD     ;IHS/SET/GTH - LISTS FILE DESCRIPTIONS ; [ 04/18/2003  9:05 AM ]

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

 +2       ;IHS/SET/GTH XB*3*9 10/29/2002  New routine.

 +3       ; This routine lists the number, name, global, and, optionally,

 +4       ; description <if any> of the selected file(s).

 +5       ;

START     ;

 +1       ; --- Display routine description.

 +2        DO HOME^%ZIS

           DO DT^DICRW

 +3        KILL ^UTILITY($JOB)

 +4        SET ^UTILITY($JOB,"XBLFD")=""

 +5        DO EN^XBRPTL

 +6        KILL ^UTILITY($JOB)

 +7        NEW QFLG,XBDESC

 +8        SET QFLG=0

 +9       ; --- Get file(s).

 +10       DO ^XBDSET

 +11       IF '$DATA(^UTILITY("XBDSET",$JOB))

               QUIT 

 +12      ; --- Print DESCRIPTION flag.

 +13       SET XBDESC=$$DIR^XBDIR("Y","Print file DESCRIPTION ","Y",$GET(DTIME,500),"You can include the DESCRIPTION of the file in your list")

 +14       IF Y="^"

               QUIT 

 +15       IF XBDESC

               NEW DIWL,DIWR,DIWF

               SET DIWL=14

               SET DIWR=74

               SET DIWF="W"

 +16      ; --- Select device.

 +17       WRITE !

 +18       SET %ZIS="Q"

           SET ZTSAVE("^UTILITY(""XBDSET"",$J,")=""

 +19       DO EN^XUTMDEVQ("EN^XBLFD","List File Descriptions.",.ZTSAVE,.%ZIS)

 +20       DO EN^XBVK("ZT")

 +21       QUIT 

 +22      ;

EN        ;PEP - List 0th node of pre-selected list of FileMan files.

 +1       ; IOF,IOSL must be set and U IO if appropriate.

 +2        IF $DATA(IOF)#2

               IF $DATA(IOSL)#2

 +3       IF '$TEST

               QUIT 

 +4        NEW F,G,N,X,QFLG

 +5       ; F:File #; G:Global; N:Zeroth

 +6        SET QFLG=0

 +7        DO HEADER

 +8        SET F=0

 +9        FOR 

               SET F=$ORDER(^UTILITY("XBDSET",$JOB,F))

               IF F'=+F

                   QUIT 

               SET G=$$FGLOB^XBFUNC(F)

               IF G'=-1

                   DO LIST

                   IF QFLG

                       QUIT 

 +10       DO ^%ZISC

 +11       QUIT 

 +12      ;

LIST      ;

 +1        IF $Y>(IOSL-3)

               DO PAGE

 +2        IF QFLG

               QUIT 

 +3        WRITE F,?13,$$FNAME^XBFUNC(F),?60,G,!

 +4        IF XBDESC

               DO DESC(F)

 +5        QUIT 

 +6       ;

DESC(F)   ; Print file DESCRIPTION.

 +1        NEW XB

 +2        FOR XB=0:0

               SET XB=$ORDER(^DIC(F,"%D",XB))

               IF 'XB

                   QUIT 

               SET X=$GET(^(XB,0))

               DO ^DIWP

               IF $Y>(IOSL-3)

                   DO PAGE

                   IF QFLG

                       QUIT 

 +3        IF QFLG

               QUIT 

 +4        DO ^DIWW

 +5        QUIT 

 +6       ;

PAGE      ; PAGE BREAK

 +1        NEW F,G,N,X

 +2        IF IO=IO(0)

               IF $EXTRACT(IOST,1,2)="C-"

                   SET Y=$$DIR^XBDIR("E")

                   IF $DATA(DIRUT)!($DATA(DUOUT))

                       SET QFLG=1

                   KILL DIRUT,DUOUT

 +3        IF QFLG

               QUIT 

 +4        DO HEADER

 +5        QUIT 

 +6       ;

HEADER    ; PRINT HEADER

 +1        WRITE @IOF,$$FMTE^XLFDT($$NOW^XLFDT),?34,"FILE DESCRIPTIONS"

 +2        XECUTE ^%ZOSF("UCI")

 +3        WRITE ?65,$PIECE(Y," ",1),!,$$REPEAT^XLFSTR("-",IOM),!,"NUMBER",?13,"FILE",?60,"GLOBAL",!

 +4        IF XBDESC

               WRITE ?13,"<DESCRIPTION>",!

 +5        WRITE $$REPEAT^XLFSTR("-",IOM),!!

 +6        QUIT 

 +7       ;