source: IHS-VA_UTILITIES-XB/trunk/XBSIC.m@ 830

Last change on this file since 830 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 3.8 KB
Line 
1XBSIC ;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 ;
9START ;
10 D INIT
11 Q:XBQFLG
12 D DBQUE
13 Q
14 ;
15INIT ; 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 ;
28DBQUE ; 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 ;
40BROWSE ;
41 S XBRP="VIEWR^XBLM(""LIST^XBSIC"")"
42 S XBRC="FILES^XBSIC",XBRX="EOJ^XBSIC",XBIOP=0
43 D ^XBDBQUE
44 Q
45 ;
46FILES ; 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 ;
51FILE(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 ;
81SET ; SET ONE LINE
82 S ^XTMP("XBSIC",XBJOB,XBFILE,$$LGR^%ZOSV_W)=""
83 Q
84 ;
85RECURSE ; 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 ;
93LIST ; 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 ;
105WRITE ; WRITE ONE LINE
106 Q:XBDEV="!" ; quit if file marker
107 D F
108 Q:XBQFLG
109 W XBDEV,!
110 Q
111 ;
112F ;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 ;
121PAUSE ; 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 ;
130HEAD ; 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 ;
137Q Q
138 ;
139EOJ ;
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 ;
Note: See TracBrowser for help on using the repository browser.