| 1 | XBLFMD ;IHS/SET/GTH - LISTS FIELDS MARKED FOR DELETION ; [ 10/29/2002 7:42 AM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;IHS/SET/GTH XB*3*9 10/29/2002 New Routine.
|
|---|
| 4 | ; List fields in the selected files that are marked for deletion.
|
|---|
| 5 | ; Output is File#, File Name, Field#, Field Name, Date Of Edit
|
|---|
| 6 | START ;
|
|---|
| 7 | ; --- Display routine description.
|
|---|
| 8 | D HOME^%ZIS,DT^DICRW
|
|---|
| 9 | KILL ^UTILITY($J)
|
|---|
| 10 | S ^UTILITY($J,"XBLFMD")=""
|
|---|
| 11 | D EN^XBRPTL
|
|---|
| 12 | KILL ^UTILITY($J)
|
|---|
| 13 | NEW QFLG
|
|---|
| 14 | S QFLG=0
|
|---|
| 15 | ; --- Get file(s).
|
|---|
| 16 | D ^XBDSET
|
|---|
| 17 | Q:'$D(^UTILITY("XBDSET",$J))
|
|---|
| 18 | D DEVICE
|
|---|
| 19 | Q:QFLG
|
|---|
| 20 | NEW F,X,XBUCI,XBDASH,XBTIME
|
|---|
| 21 | X ^%ZOSF("UCI")
|
|---|
| 22 | S XBUCI=Y,XBDASH=$$REPEAT^XLFSTR("-",IOM),XBTIME=$$FMTE^XLFDT($$NOW^XLFDT)
|
|---|
| 23 | ; F:File #
|
|---|
| 24 | S F=0
|
|---|
| 25 | F S F=$O(^UTILITY("XBDSET",$J,F)) Q:F'=+F D FIELDS(F) Q:QFLG
|
|---|
| 26 | D ^%ZISC
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | FIELDS(F) ; Process fields in File F.
|
|---|
| 30 | ; Output is File#, Field#, Field Name, Date Of Edit
|
|---|
| 31 | NEW X,XB
|
|---|
| 32 | S X=""
|
|---|
| 33 | F XB=0:0 S XB=$O(^DD(F,XB)) Q:'(XB=+XB) D D:$Y>(IOSL-3) PAGE Q:QFLG
|
|---|
| 34 | . 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"))),!
|
|---|
| 35 | . I $P(^DD(F,XB,0),"^",2) D FIELDS(+$P(^DD(F,XB,0),"^",2)) Q ; Recurse sub-file.
|
|---|
| 36 | .Q
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | PAGE ; PAGE BREAK
|
|---|
| 40 | NEW F,G,N,X
|
|---|
| 41 | I IO=IO(0),$E(IOST,1,2)="C-" S QFLG='$$DIR^XBDIR("E") I QFLG Q
|
|---|
| 42 | W @IOF
|
|---|
| 43 | W !,"Fields Marked For Deletion in ",XBUCI," uci.",?(IOM-$L(XBTIME)),XBTIME
|
|---|
| 44 | W !,"File#",?12,"File Name",?32,"Field#",?44,"Field Name",?68,"Date Of Edit"
|
|---|
| 45 | W !,XBDASH,!
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | DEVICE ; GET DEVICE (QUEUEING ALLOWED)
|
|---|
| 49 | W !
|
|---|
| 50 | S %ZIS="Q"
|
|---|
| 51 | D ^%ZIS
|
|---|
| 52 | I POP S QFLG=1 KILL POP Q
|
|---|
| 53 | I $D(IO("Q")) D S QFLG=1 Q
|
|---|
| 54 | . S ZTRTN="EN^XBLFMD",ZTIO=ION,ZTDESC="List 0th nodes",ZTSAVE("^UTILITY(""XBDSET"",$J,")=""
|
|---|
| 55 | . D ^%ZTLOAD
|
|---|
| 56 | . W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!")
|
|---|
| 57 | . D ^%ZISC
|
|---|
| 58 | . KILL ZTSK,IO("Q")
|
|---|
| 59 | . KILL ZTIO ; ^%ZTLOAD kills other ZT* variables, but not this one
|
|---|
| 60 | . Q
|
|---|
| 61 | U IO
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
