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