XBLFMD ;IHS/SET/GTH - LISTS FIELDS MARKED FOR DELETION ; [ 10/29/2002 7:42 AM ]
;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
;IHS/SET/GTH XB*3*9 10/29/2002 New Routine.
; List fields in the selected files that are marked for deletion.
; Output is File#, File Name, Field#, Field Name, Date Of Edit
START ;
; --- Display routine description.
D HOME^%ZIS,DT^DICRW
KILL ^UTILITY($J)
S ^UTILITY($J,"XBLFMD")=""
D EN^XBRPTL
KILL ^UTILITY($J)
NEW QFLG
S QFLG=0
; --- Get file(s).
D ^XBDSET
Q:'$D(^UTILITY("XBDSET",$J))
D DEVICE
Q:QFLG
NEW F,X,XBUCI,XBDASH,XBTIME
X ^%ZOSF("UCI")
S XBUCI=Y,XBDASH=$$REPEAT^XLFSTR("-",IOM),XBTIME=$$FMTE^XLFDT($$NOW^XLFDT)
; F:File #
S F=0
F S F=$O(^UTILITY("XBDSET",$J,F)) Q:F'=+F D FIELDS(F) Q:QFLG
D ^%ZISC
Q
;
FIELDS(F) ; Process fields in File F.
; Output is File#, Field#, Field Name, Date Of Edit
NEW X,XB
S X=""
F XB=0:0 S XB=$O(^DD(F,XB)) Q:'(XB=+XB) D D:$Y>(IOSL-3) PAGE Q:QFLG
. I $E($P($G(^DD(F,XB,0)),"^",1))="*" W $J(F,10),?12,$E($$FNAME^XBFUNC(F),1,20),?32,$J(XB,10),?44,$E($P($G(^DD(F,XB,0)),"^",1),1,24),?68,$$FMTE^XLFDT($G(^DD(F,XB,"DT"))),!
. I $P(^DD(F,XB,0),"^",2) D FIELDS(+$P(^DD(F,XB,0),"^",2)) Q ; Recurse sub-file.
.Q
Q
;
PAGE ; PAGE BREAK
NEW F,G,N,X
I IO=IO(0),$E(IOST,1,2)="C-" S QFLG='$$DIR^XBDIR("E") I QFLG Q
W @IOF
W !,"Fields Marked For Deletion in ",XBUCI," uci.",?(IOM-$L(XBTIME)),XBTIME
W !,"File#",?12,"File Name",?32,"Field#",?44,"Field Name",?68,"Date Of Edit"
W !,XBDASH,!
Q
;
DEVICE ; GET DEVICE (QUEUEING ALLOWED)
W !
S %ZIS="Q"
D ^%ZIS
I POP S QFLG=1 KILL POP Q
I $D(IO("Q")) D S QFLG=1 Q
. S ZTRTN="EN^XBLFMD",ZTIO=ION,ZTDESC="List 0th nodes",ZTSAVE("^UTILITY(""XBDSET"",$J,")=""
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!")
. D ^%ZISC
. KILL ZTSK,IO("Q")
. KILL ZTIO ; ^%ZTLOAD kills other ZT* variables, but not this one
. Q
U IO
Q
;
XBLFMD ;IHS/SET/GTH - LISTS FIELDS MARKED FOR DELETION ; [ 10/29/2002 7:42 AM ]
+1 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
+2 ;IHS/SET/GTH XB*3*9 10/29/2002 New Routine.
+3 ; List fields in the selected files that are marked for deletion.
+4 ; Output is File#, File Name, Field#, Field Name, Date Of Edit
START ;
+1 ; --- Display routine description.
+2 DO HOME^%ZIS
DO DT^DICRW
+3 KILL ^UTILITY($JOB)
+4 SET ^UTILITY($JOB,"XBLFMD")=""
+5 DO EN^XBRPTL
+6 KILL ^UTILITY($JOB)
+7 NEW QFLG
+8 SET QFLG=0
+9 ; --- Get file(s).
+10 DO ^XBDSET
+11 IF '$DATA(^UTILITY("XBDSET",$JOB))
QUIT
+12 DO DEVICE
+13 IF QFLG
QUIT
+14 NEW F,X,XBUCI,XBDASH,XBTIME
+15 XECUTE ^%ZOSF("UCI")
+16 SET XBUCI=Y
SET XBDASH=$$REPEAT^XLFSTR("-",IOM)
SET XBTIME=$$FMTE^XLFDT($$NOW^XLFDT)
+17 ; F:File #
+18 SET F=0
+19 FOR
SET F=$ORDER(^UTILITY("XBDSET",$JOB,F))
IF F'=+F
QUIT
DO FIELDS(F)
IF QFLG
QUIT
+20 DO ^%ZISC
+21 QUIT
+22 ;
FIELDS(F) ; Process fields in File F.
+1 ; Output is File#, Field#, Field Name, Date Of Edit
+2 NEW X,XB
+3 SET X=""
+4 FOR XB=0:0
SET XB=$ORDER(^DD(F,XB))
IF '(XB=+XB)
QUIT
Begin DoDot:1
+5 IF $EXTRACT($PIECE($GET(^DD(F,XB,0)),"^",1))="*"
WRITE $JUSTIFY(F,10),?12,$EXTRACT($$FNAME^XBFUNC(F),1,20),?32,$JUSTIFY(XB,10),?44,$EXTRACT($PIECE($GET(^DD(F,XB,0)),"^",1),1,24),?68,$$FMTE^XLFDT($GET(^DD(F,XB,"DT"))),!
+6 ; Recurse sub-file.
IF $PIECE(^DD(F,XB,0),"^",2)
DO FIELDS(+$PIECE(^DD(F,XB,0),"^",2))
QUIT
+7 QUIT
End DoDot:1
IF $Y>(IOSL-3)
DO PAGE
IF QFLG
QUIT
+8 QUIT
+9 ;
PAGE ; PAGE BREAK
+1 NEW F,G,N,X
+2 IF IO=IO(0)
IF $EXTRACT(IOST,1,2)="C-"
SET QFLG='$$DIR^XBDIR("E")
IF QFLG
QUIT
+3 WRITE @IOF
+4 WRITE !,"Fields Marked For Deletion in ",XBUCI," uci.",?(IOM-$LENGTH(XBTIME)),XBTIME
+5 WRITE !,"File#",?12,"File Name",?32,"Field#",?44,"Field Name",?68,"Date Of Edit"
+6 WRITE !,XBDASH,!
+7 QUIT
+8 ;
DEVICE ; GET DEVICE (QUEUEING ALLOWED)
+1 WRITE !
+2 SET %ZIS="Q"
+3 DO ^%ZIS
+4 IF POP
SET QFLG=1
KILL POP
QUIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET ZTRTN="EN^XBLFMD"
SET ZTIO=ION
SET ZTDESC="List 0th nodes"
SET ZTSAVE("^UTILITY(""XBDSET"",$J,")=""
+7 DO ^%ZTLOAD
+8 WRITE !!,$SELECT($DATA(ZTSK):"Request queued!",1:"Request cancelled!")
+9 DO ^%ZISC
+10 KILL ZTSK,IO("Q")
+11 ; ^%ZTLOAD kills other ZT* variables, but not this one
KILL ZTIO
+12 QUIT
End DoDot:1
SET QFLG=1
QUIT
+13 USE IO
+14 QUIT
+15 ;
