| [641] | 1 | XBSIC ;IHS/SET/GTH - LIST ID,SP,FD NODES ON SELECTED FILES ; [ 12/05/2002 4:28 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;IHS/SET/GTH XB*3*9 10/29/2002 New Routine.
|
|---|
| 4 | ; This routine lists the IDENTIFIERS, SPECIFIERS, and
|
|---|
| 5 | ; CONDITIONALS from selected files.
|
|---|
| 6 | ;
|
|---|
| 7 | ; Thanks to E. Don Enos for the original routine in Sep 1997.
|
|---|
| 8 | ;
|
|---|
| 9 | START ;
|
|---|
| 10 | D INIT
|
|---|
| 11 | Q:XBQFLG
|
|---|
| 12 | D DBQUE
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | INIT ; INITIALIZATION
|
|---|
| 16 | D EN^XBVK("XB")
|
|---|
| 17 | S (XBBT)=$H,XBJOB=$J
|
|---|
| 18 | S XBQFLG=1
|
|---|
| 19 | I '$G(DUZ(2)) W !!,"Your DUZ(2) is not set!",!! Q
|
|---|
| 20 | I '$G(^AUTTLOC(DUZ(2),0)) W !!,"The site specified in your DUZ(2) does not exist!",!! Q
|
|---|
| 21 | KILL ^XTMP("XBSIC",XBJOB)
|
|---|
| 22 | D ^XBKVAR
|
|---|
| 23 | D ^XBDSET ; get files to check
|
|---|
| 24 | I '$O(^UTILITY("XBDSET",XBJOB,0)) Q ; quit if no files selected
|
|---|
| 25 | S XBQFLG=0
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | DBQUE ; call to XBDBQUE
|
|---|
| 29 | W !
|
|---|
| 30 | S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P"
|
|---|
| 31 | KILL DA
|
|---|
| 32 | D ^DIR
|
|---|
| 33 | KILL DIR
|
|---|
| 34 | Q:$D(DIRUT)
|
|---|
| 35 | I Y="B" D BROWSE Q
|
|---|
| 36 | S XBRP="LIST^XBSIC",XBRC="FILES^XBSIC",XBRX="EOJ^XBSIC",XBNS="XB"
|
|---|
| 37 | D ^XBDBQUE
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | BROWSE ;
|
|---|
| 41 | S XBRP="VIEWR^XBLM(""LIST^XBSIC"")"
|
|---|
| 42 | S XBRC="FILES^XBSIC",XBRX="EOJ^XBSIC",XBIOP=0
|
|---|
| 43 | D ^XBDBQUE
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | FILES ; PROCESS ALL FILES
|
|---|
| 47 | S XBFILE=0
|
|---|
| 48 | F S XBFILE=$O(^UTILITY("XBDSET",XBJOB,XBFILE)) Q:'XBFILE D FILE(XBFILE) Q:XBQFLG
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | FILE(XBFILE) ; PROCESS ONE FILE (CALLED RECURSIVELY)
|
|---|
| 52 | NEW L,V,W,X,Y
|
|---|
| 53 | I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST,1,2)="C-" W "."
|
|---|
| 54 | S ^XTMP("XBSIC",XBJOB,XBFILE,"!")="" ; file marker
|
|---|
| 55 | F X="FD","ID","SP" D
|
|---|
| 56 | . I '$D(^DD(XBFILE,0,X)) Q ; quit if no node
|
|---|
| 57 | . I X="ID",'$O(^DD(XBFILE,0,X,0)) Q ; quit if no real identifier
|
|---|
| 58 | . S Y=0
|
|---|
| 59 | . F S Y=$O(^DD(XBFILE,0,X,Y)) Q:Y="" I Y D
|
|---|
| 60 | .. S V=$G(^DD(XBFILE,0,X,Y)) ; get value & set $ZR
|
|---|
| 61 | .. I X="SP" S W=$S(V'="":"="_V,1:"") D SET Q
|
|---|
| 62 | .. I X="ID" S W="" D SET Q
|
|---|
| 63 | .. S L=""
|
|---|
| 64 | .. F S L=$O(^DD(XBFILE,0,X,Y,L)) Q:L="" D
|
|---|
| 65 | ... S V=$G(^DD(XBFILE,0,X,Y,L)) ; get value & set $ZR
|
|---|
| 66 | ... S W="="_V D SET
|
|---|
| 67 | ... Q
|
|---|
| 68 | .. Q
|
|---|
| 69 | . Q
|
|---|
| 70 | ;I $P($G(^DD(XBFILE,.01,0)),U,2)["P" S X=^(0) D RECURSE ;ptr chain
|
|---|
| 71 | I $P($G(^DD(XBFILE,.01,0)),U,2)["P" S X=^(0) I '(XBFILE=+$P($P(X,U,2),"P",2)) D FILE(+$P($P(X,U,2),"P",2))
|
|---|
| 72 | Q
|
|---|
| 73 | Q:$G(RECURSE) ; quit if recursing
|
|---|
| 74 | S XBFLD=.01
|
|---|
| 75 | F S XBFLD=$O(^DD(XBFILE,XBFLD)) Q:'XBFLD I $D(^(XBFLD,0)) S X=^(0) D
|
|---|
| 76 | . Q:$P(X,U,2)'["P" ; quit if not pointer
|
|---|
| 77 | . D RECURSE
|
|---|
| 78 | . Q
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | SET ; SET ONE LINE
|
|---|
| 82 | S ^XTMP("XBSIC",XBJOB,XBFILE,$$LGR^%ZOSV_W)=""
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | RECURSE ; RECURSE FOR FILES BEING POINTED TO
|
|---|
| 86 | Q:XBFILE=+$P($P(X,U,2),"P",2) ; quit if self reference
|
|---|
| 87 | NEW XBFILE,RECURSE
|
|---|
| 88 | S RECURSE=1
|
|---|
| 89 | S XBFILE=+$P($P(X,U,2),"P",2)
|
|---|
| 90 | D FILE
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | LIST ; LIST OUTPUT
|
|---|
| 94 | U IO
|
|---|
| 95 | D HEAD
|
|---|
| 96 | S XBFILE=0
|
|---|
| 97 | F S XBFILE=$O(^XTMP("XBSIC",XBJOB,XBFILE)) Q:'XBFILE D Q:XBQFLG
|
|---|
| 98 | . D F Q:XBQFLG
|
|---|
| 99 | . W !,?4,XBFILE_" ("_$P($G(^DIC(XBFILE,0)),U)_")",!
|
|---|
| 100 | . S XBDEV=""
|
|---|
| 101 | . F S XBDEV=$O(^XTMP("XBSIC",XBJOB,XBFILE,XBDEV)) Q:XBDEV="" D WRITE Q:XBQFLG
|
|---|
| 102 | . Q
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | WRITE ; WRITE ONE LINE
|
|---|
| 106 | Q:XBDEV="!" ; quit if file marker
|
|---|
| 107 | D F
|
|---|
| 108 | Q:XBQFLG
|
|---|
| 109 | W XBDEV,!
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | F ;Form feed
|
|---|
| 113 | I ($Y+4)>IOSL D
|
|---|
| 114 | . I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST,1,2)'="P-" D PAUSE S:$D(DIRUT) XBQFLG=1
|
|---|
| 115 | . Q:XBQFLG
|
|---|
| 116 | . W @IOF
|
|---|
| 117 | . D HEAD
|
|---|
| 118 | . Q
|
|---|
| 119 | Q
|
|---|
| 120 | ;
|
|---|
| 121 | PAUSE ; PAUSE FOR USER
|
|---|
| 122 | Q:$E(IOST)'="C"
|
|---|
| 123 | Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
|
|---|
| 124 | S DIR(0)="E",DIR("A")="Press any key to continue"
|
|---|
| 125 | KILL DIRUT
|
|---|
| 126 | D ^DIR
|
|---|
| 127 | KILL DIR
|
|---|
| 128 | Q
|
|---|
| 129 | ;
|
|---|
| 130 | HEAD ; WRITE HEADER
|
|---|
| 131 | I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST,1,2)="C-" W @IOF
|
|---|
| 132 | S XBPG=$G(XBPG)+1
|
|---|
| 133 | W " ID/SP/FD REPORT run at ",$P(^AUTTLOC(DUZ(2),0),U,2)," on ",$$FMTE^XLFDT(DT),?75,$J(XBPG,5),!
|
|---|
| 134 | W $$REPEAT^XLFSTR("=",80),!
|
|---|
| 135 | Q
|
|---|
| 136 | ;
|
|---|
| 137 | Q Q
|
|---|
| 138 | ;
|
|---|
| 139 | EOJ ;
|
|---|
| 140 | S XBET=$H,XBTS=(86400*($P(XBET,",")-$P(XBBT,",")))+($P(XBET,",",2)-$P(XBBT,",",2)),XBH=+$P(XBTS/3600,"."),XBTS=XBTS-(XBH*3600),XBM=+$P(XBTS/60,"."),XBTS=XBTS-(XBM*60),XBS=XBTS
|
|---|
| 141 | W !!,"RUN TIME (H.M.S): "_XBH_"."_XBM_"."_XBS,!
|
|---|
| 142 | KILL ^XTMP("XBSIC",XBJOB)
|
|---|
| 143 | KILL ^UTILITY("XBDSET",XBJOB)
|
|---|
| 144 | D EN^XBVK("XB")
|
|---|
| 145 | Q
|
|---|
| 146 | ;
|
|---|
