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