source: IHS-VA_UTILITIES-XB/trunk/XBCDIC.m@ 1751

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

Modified directory structure; moved routines.
File size: 6.8 KB
Line 
1XBCDIC ; IHS/ADC/GTH - CLEAN UP ^DIC AND ^DD ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; PROGRAMMERS NOTE:
5 ; THIS FUNCTIONALITY HAS BEEN INCLUDED IN THE FILEMAN
6 ; DD UTILITIES, BEGINNING WITH V 19.0. WE RECOMMEND
7 ; IT'S USE AS IT IS MORE LIKELY TO BE CURRENT.
8 ; 3-20-96
9 ;
10 ; This routine cleans up ^DIC and ^DD by a range of
11 ; dictionary numbers. All files in ^DIC within the range
12 ; of dictionary numbers are checked for the following:
13 ;
14 ; They must have a NAME in ^DIC.
15 ; The NAME in ^DIC must match the NAME in ^DD.
16 ; The NAME must exist in ^DIC("B" with the correct number,
17 ; and that number cannot occur more than once in ^DIC("B".
18 ; They must have a data global specified in ^DIC.
19 ; The data global must be in the correct form.
20 ; The data global must exist.
21 ; The data global must have a 0th node.
22 ; The NAME and NUMBER in the data global must match ^DIC.
23 ; The data globals 0th node must be consistent with
24 ; the data (Exact count not checked).
25 ;
26 ; They must have valid entries in ^DD as follows:
27 ; The ^DD entry must have a .01 field.
28 ; All "SB" pointers must point to existing sub-files.
29 ; All sub-files must point back to correct parent.
30 ; All "TRB" entries must exist.
31 ; All "PT" entries must exist.
32 ; All "ACOMP" entries must exist.
33 ;
34 ; When discrepancies are found the entries are corrected
35 ; automatically where ever possible. If this is not possible
36 ; operator interaction occurs to make the corrections. If
37 ; the file cannot be corrected, it will be deleted.
38 ;
39 ; After all dictionaries within the range of dictionary
40 ; numbers are checked, all other entries within the range
41 ; will be deleted.
42 ;
43 ; The last step is to set the 0th node of the FILE OF FILES
44 ; to the correct high DFN and the correct count of entries.
45 ;
46BEGIN ;
47 S U="^"
48 W !!,"THIS FUNCTIONALITY HAS BEEN INCLUDED IN THE FILEMAN"
49 W !,"DD UTILITIES, BEGINNING WITH V 19.0. WE RECOMMEND"
50 W !,"IT'S USE AS IT IS MORE LIKELY TO BE CURRENT."
51 W !," 3-20-96",!!
52 Q:'$$DIR^XBDIR("E")
53 W !!,"This routine cleans up ^DIC and ^DD by a range of dictionary numbers."
54LO ;
55 R !!,"Enter low number of range: ",XBCDLO:$G(DTIME,999)
56 G:XBCDLO'=+XBCDLO EOJ
57HI ;
58 R !,"Enter high number of range: ",XBCDHI:$G(DTIME,999)
59 S:XBCDHI="" XBCDHI=XBCDLO
60 G:XBCDHI'=+XBCDHI!(XBCDHI<XBCDLO) EOJ
61 I XBCDLO<2 W !!,"*** Don't mess with files less than 2!! ***",*7 G EOJ
62 S XBDSLO=XBCDLO,XBDSHI=XBCDHI
63 D EN1^XBDSET
64 I '$D(^UTILITY("XBDSET",$J)) W !!,"No dictionaries were selected!" G EOJ
65 D ^XBCDIC2 ; Check names and data globals *****
66 D ^XBCDICD ; Delete bad files found by ^XBCDIC2 *****
67 S XBDSLO=XBCDLO,XBDSHI=XBCDHI
68 D EN1^XBDSET ; Get list again *****
69 D ^XBCDIC3 ; Check ^DD entries *****
70 S XBRLO=XBCDLO,XBRHI=XBCDHI
71 D EN1^XBRESID ; Check dangling ^DD entries *****
72 W !!,"Now confirming ^DIC(""B"")"
73 S XBCDX=""
74 F XBCDL=0:0 S XBCDX=$O(^DIC("B",XBCDX)) Q:XBCDX="" S XBCDFILE="" F XBCDL=0:0 S XBCDFILE=$O(^DIC("B",XBCDX,XBCDFILE)) Q:XBCDFILE="" I XBCDFILE'<XBCDLO,XBCDFILE'>XBCDHI W "." D BCHK
75 S XBCDFILE=XBCDLO-.00000001
76 F XBCDL=0:0 S XBCDFILE=$O(^DIC(XBCDFILE)) Q:XBCDFILE'=+XBCDFILE I XBCDFILE'>XBCDHI W "." S XBCDNDIC=$P(^DIC(XBCDFILE,0),U,1) I XBCDNDIC]"",'$D(^DIC("B",XBCDNDIC,XBCDFILE)) S ^(XBCDFILE)="" W "|"
77 G EOJ
78 ;
79BCHK ;
80 I '$D(^DIC(XBCDFILE,0))#2 KILL ^DIC("B",XBCDX,XBCDFILE) W "|" Q
81 I XBCDX'=$P(^DIC(XBCDFILE,0),U,1) KILL ^DIC("B",XBCDX,XBCDFILE) W "|"
82 Q
83EOJ ;
84 KILL XBCDLO,XBCDHI,XBCDUCI,XBCDL,XBCDFILE,XBCDX,XBCDNDIC
85 KILL ^UTILITY("XBDSET",$J)
86 Q
87 ;
88 W !,"Package ",XBBPPRFX," has no pre-initialization routine entry!",!
89 Q
90 ;
91EOJ3 ;
92 KILL ^UTILITY("XBBPI",$J),^UTILITY("XBBPPGM",$J),^UTILITY("XBBPI EXEC",$J)
93 KILL %,%DT,DIE,XCN
94 KILL XBBPDFN,XBBPFLE,XBBPFLG,XBBPI,XBBPL,XBBPP,XBBPPGM,XBBPPRFX,XBBPX,XBBPY
95 Q
96 ;
97DTA ;
98 ;; K ^UTILITY("XBDSET",$J) F XBBPI=1:1 S XBBPIX=$P($T(Q+XBBPI),";;",2) Q:XBBPIX="" S XBBPIY=$P(XBBPIX,"=",2,99),XBBPIX=$P(XBBPIX,"=",1) S @XBBPIX=XBBPIY
99 ;; K XBBPI,XBBPIX,XBBPIY D EN2^XBKD
100 ;;Q Q
101 ; ex: D to denote DUZ
102 ; '|' Separator
103 ;
104 ; variable1 User's choice of the local variable
105 ; ex: DUZ
106 ; '*' Repetative marker if more than one
107 ; mnemonic is indicated
108 ;
109 ; USE The mnemonic reference can be used any where
110 ; in the WP form.
111 ; Format ~mnemonic|variable subscript~
112 ;
113 ; '~' Beginning marker for the variable
114 ;
115 ; mnemonic1 User's mnemonic
116 ;
117 ; '|' Separator
118 ;
119 ; subscript The subscript of the variable to be used
120 ;
121 ; '~' Ending marker for the variable
122 ;
123 ; ex: ~D|~ for DUZ
124 ; ~D|0~ for DUZ(0)
125 ; ~I|.01~ for BARIPT(.01)
126 ;
127 ; MUMPS OUTPUT A simple mumps output transform is also
128 ; TRANSFORM provided to aid in form design. A variable or
129 ; mnemonic indicated will have its output
130 ; transformed prior to being put into the form.
131 ;
132 ; SETUP
133 ;
134 ; *var1!mumps code1*var2!mumps code2
135 ; *mnemonic3!mumps code3*mnemonic4!mumps code4
136 ;
137 ; Ex: *DUZ(2)!$J(X,10,2) will output $J(DUZ(2),10,2)
138 ; *D|2!$J(X,10,2) mnemonic notation of same
139 ;
140 ; '*' Output Transform marker in column one. At TOF
141 ;
142 ; Variable/ Variable or mnemonic as it would appear in the
143 ; Mneumonic form between '~'s.
144 ;
145 ; '!' Separator
146 ;
147 ; mumps code Mumps code expression as a function of x.
148 ; Do not state 'S X=f(x)'
149 ; Enter the function only, f(x).
150 ;
151 ; '*' Separator if more than one is put on one line.
152 ;
153 ; SPECIAL OUTPUT TRANSFORMS provided by XBARRAY
154 ;
155 ; xxx!$$MDY(X) a literal ~"NOW"~ or variable ~IT|9~
156 ; ex: *"NOW"!$$MDY(X) or *IT|9!$$MDY(X)
157 ; returns mm/dd/yy
158 ;
159 ; xxx!$$WP("X") for a word processing field
160 ; NOTE: "X" IS ABSOLUTELY NECESSARY
161 ; The variable array must have the form
162 ; VAR(subcript,n) where n = 1:1
163 ;
164DOCE ;
165 ;
166TEST ; If you have A/R installed, uncomment the following lines for a
167 ; demonstration.
168 ; D INIT^BARUTL
169 ; D ENP^XBDIQ1(200,DUZ,".01:.116","BARU(")
170 ; S BARFORM="PW TEST"
171 ; D EDIT^XBARRAY(.BARFORM,90053.01,1000)
172 ; S Y=$$GEN^XBARRAY(.BARFORM,90053.01,1000,"BARFM",0,10)
173 ; K BARFORM(BARFORM)
174 ; Q
175 ;
176 NEW I,W
177 S XBLWP=$G(XBLLINE),W=$P(X,")")
178 F I=0:1 S X=$Q(@X) Q:X="" Q:(W'=$P(X,",")) D
179 . S T=@X,XBLLINE=XBLWP+I
180 . S:'$G(XBFMT) XBZ(XBL+XBLLINE)=T
181 . S:($G(XBFMT)=1) XBZ(XBL+XBLLINE,0)=T
182 Q ""
183 ;
Note: See TracBrowser for help on using the repository browser.