source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOS.m@ 1007

Last change on this file since 1007 was 931, checked in by Sam Habiel, 14 years ago

Changes in BMXMON to add process name and fix timeouts; change in version number to 2.2
File size: 9.2 KB
Line 
1BMXADOS ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE ;
2 ;;2.2;BMX;;Sep 07, 2010
3 ; ENABLES NAVIGATION TO SUBFILES PRIOR TO UPDATING THE SCHEMA FILE ENTRY
4 ;
5 ;
6 ;
7UPDATE ; UPDATE THE SCHEMA FILE
8 N DIC,X,Y,%,STOP,FIEN,FNAME,SNAME,SIEN
9UDIC S DIC("A")="Enter schema name: " ; EP FROM VENPCCTU
10 S DIC(0)="AEQLM",DIC="^BMXADO("
11 D ^DIC I Y=-1 G FIN
12SCHEMA S SNAME=$P(Y,U,2),SIEN=+Y
13 S FIEN=$$FILE(SIEN) I 'FIEN G FIN
14 I FIEN'=$P($G(^BMXADO(SIEN,0)),U,2) S DIE=DIC,DA=SIEN,DR=".02////^S X=FIEN" D ^DIE
15 F D FLD(FIEN,SIEN) I $G(STOP) Q ; GET FIELD INFO
16FIN D ^XBFMK
17 Q
18 ;
19FLD(FIEN,SIEN) ; GET THE FIELD
20 N DIC,X,Y,DIE,DA,DR,FLDIEN,FLDNAME,FLDTYPE,FDEF,TRANS
21 N %,%Y,HDR,DTYPE,LEN,FARR,I,TOT,PAUSE,PFLAG,IFLAG,IMSG,STG,READ
22 D FLIST(.FARR,FIEN,0)
23 S TOT=$O(FARR(9999),-1) I 'TOT S STOP=1 Q
24 W !,"Select a field from this "_$S($D(^DD(FIEN,0,"UP")):"sub-",1:"")_"file: "
25 S I=0 F S I=$O(FARR(I)) Q:'I S PAUSE=$$PAUSE(I) Q:PAUSE'="" W I,?3,FARR(I)
26 I $G(PAUSE)=U S STOP=1 Q
27 I $G(PAUSE) S Y=PAUSE G FLD1
28 S DIR(0)="NO^1:"_TOT_":",DIR("A")="Select a field from the list" K DA D ^DIR K DIR
29 I 'Y S STOP=1 Q
30FLD1 S %=FARR(+Y)
31 S FLDIEN=+$P(%," [",2),FLDNAME=$P(%," [")
32 I $$FDEL(SIEN,FLDIEN) Q ; FIELD DELETED
33 S X=$$FDEF(FIEN,FLDIEN) I '$L(X) W " ??" Q
34 S DTYPE=$E(X),LEN=+$E(X,2,6)
35 S DIR(0)="F^1:30",DIR("A")="Column header",DIR("B")=FLDNAME D ^DIR K DIR
36 S HDR=Y,TRANS=0
37 S %=$P($G(^DD(FIEN,FLDIEN,0)),U,2) ; CHECK FM DD TO SEE IF FIELD IS REQUIRED
38 I %["R" W !,"FileMan requires a non-null value for this field" S %=2
39 E W !,"Is null allowed" S %=$S(FLDIEN=.01:2,1:1) D YN^DICN I %Y?1."^" Q
40 I %=2 S TRANS=1 ; NON NULL VALUE REQUIRED TO COMPLETE THE TRANSACTION OR THERE WILL BE ROLLBACK
41 I $G(PFLAG) D ; IF POINTER, ASK IF USER WANTS TO AUTOMATICALLY INSERT THE LOOKUP VALUE FIELD IN THE SCHEMA
42 . W !,"This field is a pointer value (IEN)."
43 . W !,"Want to automatically insert the lookup value in the schema"
44 . S %=2 D YN^DICN W ! I %=1 S PFLAG=2
45 . Q
46IFLG I $G(IFLAG) D ; NON-POINTER .01 FIELD. ASK IF USER WANTS TO REFERENCE IDENTIFIER EP
47 . W !,"Want to display identifiers with this field"
48 . S %=2 D YN^DICN W ! I %'=1 Q
49 . S IMSG="Respond with a valid entry point in the format 'TAG^ROUTINE'."
50 . W !,"Entry Point to generate Identifiers: " R Y:$G(DTIME,60) E Q
51 . I Y?1."^" Q
52 . I Y?1."?" W !,IMSG S IFLAG(0)="!" Q
53 . I Y'?1U.7UN1"^"1U.7UN S IFLAG(0)="!" W " ??"
54 . I $L(Y)>2 S IFLAG(0)=Y,IFLAG=2
55 . Q
56 I $G(IFLAG(0))="!" W !,IMSG K IPFLAG(0),IMSG W !!! G IFLG
57 S DA(1)=SIEN,DIC="^BMXADO("_DA(1)_",1,"
58 S DIC("P")=90093.991,DIC(0)="L",X=FLDIEN
59 I '$D(^BMXADO(SIEN,1,0)) S ^BMXADO(SIEN,1,0)="^90093.991^^"
60 D ^DIC I Y=-1 Q
61 S READ=($P($G(^DD(FIEN,FLDIEN,0)),U,2)["C") ; COMPUTED FIELDS ARE READ ONLY!
62 S DIE=DIC,DA=+Y
63 S DR=".02///^S X=DTYPE;.03///^S X=LEN;.04///^S X=HDR;.05///^S X=READ;.06///0;.07///^S X=('TRANS)"
64 D ^DIE
65 I $G(IFLAG)=2 D ID
66 I $G(PFLAG)'=2 Q
67LKUP ; AUTOMATICALLY ADD A LOOKUP FIELD TO THE SCHEMA
68 S X=FLDIEN_"IEN"
69 D ^DIC I Y=-1 Q
70 W !,"The LOOKUP field '"_X_"' has been added to the schema",!
71 S HDR=HDR_"_IEN",DTYPE="I",LEN="00009"
72 S DIE=DIC,DA=+Y
73 S DR=".02///^S X=DTYPE;.03///^S X=LEN;.04///^S X=HDR;.05///^S X=READ;.06///0;.07///^S X=('TRANS)"
74 D ^DIE
75 Q
76 ;
77ID ; AUTOMATICALLY ADD AN IDENTIFIER REFERENCE
78 N X,Y,DIE,DR,DA,REF
79 S X=".01ID",DA(1)=SIEN
80 S REF=IFLAG(0) I '$L(REF) Q
81 D ^DIC I Y=-1 Q
82 W !,"The identifier field '"_X_"' has been added to the schema",!
83 S HDR=HDR_"_ID",DTYPE="T",LEN="00017"
84 S DIE=DIC,DA=+Y
85 S DR=".02///^S X=DTYPE;.03///^S X=LEN;.04///^S X=HDR;.05///^S X=READ;.06///0;.07///^S X=('TRANS);1///^S X=REF"
86 D ^DIE
87 Q
88 ;
89FDEL(SIEN,FIELD) ; DELETE AN EXISTING ENTRY FROM THE 'FIELD' MULTIPLE. RETURN '1' IF THE RECORD WAS DELETED
90 N FIEN,DA,DIK
91 S FIEN=$O(^BMXADO(SIEN,1,"B",FIELD,0)) I 'FIEN Q 0 ; THIS IS A NEW ENTRY
92 W !,"This field already is attached to the schema. Want to delete it"
93 S %=2 D YN^DICN
94 I %'=1 Q 0
95 S DA(1)=SIEN,DIK="^BMXADO("_DA(1)_",1,",DA=FIEN
96 D ^DIK
97 S FIEN=$O(^BMXADO(SIEN,1,"B",(FIELD_"IEN"),0))
98 I FIEN S DA=FIEN D ^DIK ; DELETE LOOKUP VALUE FIELD AS WELL
99 W " Done!",!
100 Q 1
101 ;
102FDEF(FILE,FIELD) ;EP - GIVEN A FILEMAN FILE AND FIELD, RETURN THE DATA DEFINITION IN ADO FORMAT
103 N %,X,Y,Z,STG,I,DTYPE,FNAME,LEN,DNAME
104 I '$D(^DD(+$G(FILE),+$G(FIELD),0)) Q ""
105 S STG=$G(^DD(FILE,FIELD,0)) I '$L(STG) Q "" ; GET DATA DEF STRING
106DTYPE S %="DNSFWCPVM",X=$P(STG,U,2),DTYPE="" ; GET DATA TYPE
107 F I=1:1:$L(%) S Y=$E(%,I) I X[Y S DTYPE=Y Q
108 I DTYPE="" Q ""
109FNAME S DNAME=$P(STG,U) I '$L(DNAME) Q "" ; FIELD NAME
110DDA ; ADO FORMAT
111 I DTYPE="D" D Q "D"_LEN_DNAME
112 . S LEN="00021"
113 . I STG["S %DT=" S %=$P(STG,"S %DT=",2),%=$P(%,$C(34))
114 . I $G(FLDIEN)=.01 S IFLAG=1
115 . I %["S" S LEN="00019" Q
116 . I %["T" S LEN="00018" Q
117 . Q
118 I DTYPE="N",STG["1N.N" D Q:'LEN "" Q "I"_LEN_DNAME ; INTEGER
119 . S %=+$P(STG,"K:+X'=X!(X>",2)
120 . S Y=$L(%)
121 . S LEN=$E("00000",1,5-$L(Y))_Y
122 . Q
123 I DTYPE="N" D Q:'LEN "" Q "N"_LEN_DNAME ; NUMBER (COULD HAVE A DECIMAL VALUE)
124 . S %=+$P(STG,"!(X?.E1"".""",2)
125 . S X=+$P(STG,"K:+X'=X!(X>",2)
126 . S Y=%+($L(+X))
127 . S LEN=$E("00000",1,5-$L(Y))_Y
128 . Q
129 I DTYPE="F" D Q:'LEN "" Q "T"_LEN_DNAME
130 . S Y=+$P(STG,"K:$L(X)>",2)
131 . S LEN=$E("00000",1,5-$L(Y))_Y
132 . I 'LEN S LEN="00030"
133 . I $G(FLDIEN)=.01 S IFLAG=1
134 . Q
135 I DTYPE="S" D Q:'LEN "" Q "T"_LEN_DNAME
136 . S X=$P(STG,U,3),Y=0
137 . F I=1:1:$L(X,":") S Z=$P(X,":",2),Z=$P(Z,";"),%=$L(Z) I %>Y S Y=%
138 . S LEN=$E("00000",1,5-$L(Y))_Y
139 . Q
140 I DTYPE="P" S PFLAG=1 Q "T00030"_DNAME
141 I DTYPE="W" Q "T05000"_DNAME
142 I DTYPE="V" Q ""
143 Q "T00250"_DNAME
144 ;
145FILE(SIEN) ; GET THE FILE OR SUBFILE NUMBER
146 N FNO,FIEN,DIC,X,Y,%,FILE,NSTG,GBL,FNAME,SUB,FARR,TOT,I
147 S (FILE,FNO)=$P(^BMXADO(SIEN,0),U,2)
148OLD I FNO D I $G(FIEN) Q FIEN
149 . S NSTG=$O(^DD(FNO,0,"NM",""))
150 . F S FNO=$G(^DD(FNO,0,"UP")) Q:'FNO S NSTG=$O(^DD(FNO,0,"NM",""))_"/"_NSTG
151OLD1 . W !,$S(NSTG["/":"Sub-",1:""),"File #",FILE," (",NSTG,") is linked to this schema."
152 . W !,"Want to keep it" S %=1
153 . D YN^DICN I %'=2 W:%=1 " OK" S FIEN=FILE Q
154 . W !!,"If you change or delete this file number,",!,"all the information in this schema will be deleted."
155 . W !,"Are you sure you want to do this" S %=2 D YN^DICN
156 . I %'=1 W !! G OLD1
157 . S GBL="^BMXADO("_SIEN_")"
158 . K @GBL@(1),@GBL@(2)
159 . S $P(@GBL@(0),U,2)=""
160 . W !,"This schema definition has been deleted. You may redefine it now"
161 . Q
162NEW S DIC=1,DIC(0)="AEQM" D ^DIC I Y=-1 Q ""
163 S FNO=+Y,FNAME=$P(Y,U,2)
164NEW1 D SC(.FARR,FNO,1)
165 S TOT=$O(FARR(999999),-1) I 'TOT Q FNO ; NO SUBFILES FOUND
166 W !!,"The ",FNAME," file contains the following sub-file" I TOT>1 W "s"
167 W !
168 S I=0 F S I=$O(FARR(I)) Q:'I S PAUSE=$$PAUSE(I) Q:PAUSE'="" W I,?3,FARR(I)
169 I $G(PAUSE)=U Q ""
170 I $G(PAUSE) S Y=PAUSE G NEW2
171 W !!,"Is the schema linked to a sub-file in this list"
172 S %=2 D YN^DICN I %=2 Q FNO
173 S DIR(0)="NO^1:"_TOT_":",DIR("A")="Select a sub-file from the list" K DA D ^DIR K DIR
174 I 'Y Q ""
175NEW2 Q +$P(FARR(+Y)," (",2)
176 ;
177PAUSE(I) ; SCROLL CHECK
178 N %
179 W !
180 I (I#20) Q ""
181 W "Select a number from the list (1-",(I-1),") or press <ENTER> to continue: "
182 R %:$G(DTIME,60) E Q ""
183 I %?1."^" Q U
184 I $L(%),$D(FARR(I)) Q %
185 I $L(%) W " ??" H 2
186 W $C(13),?79,$C(13)
187 Q ""
188 ;
189SC(OUT,FILE,MODE) ;EP - SUB CRAWLER. GIVEN A FILE NUMBER RETURN ALL OF ITS DESCENDANT FILES IN AN ARRAY
190 I '$D(^DD(FILE,"SB")) Q ; NO DESCENDANTS
191 N TOT,FNO,FNAME,FIEN,LEVEL,NODE,SARR,STG,X,%,UP,ARR
192 S FIEN=FILE,TOT=0
193 D PASS1
194 I '$O(ARR(0)) Q
195SC2 ; SECOND PASS. BUILD THE INTERMEDIATE ARRAY
196 S FNO=0 F S FNO=$O(ARR(FNO)) Q:'FNO D
197 . I $P($G(^DD(FNO,.01,0)),U,2)["W" K ARR(FNO) Q ; WORD PROCESSING FIELDS DO NOT COUNT
198 . S STG=FNO,UP=FNO
199 . F S UP=$G(^DD(UP,0,"UP")) Q:'UP S STG=UP_","_STG ; BUILD DESCENDANT STRING
200 . I $G(MODE) S STG=$$ASTG(STG)
201 . S STG=$P(STG,",",2,99) ; DONT NEED TOP LEVEL FILE
202 . I '$L(STG) Q ; SOMETHING IS SCREWED UP
203 . S LEVEL=$L(STG,",")
204 . S FNAME=$O(^DD(FNO,0,"NM",""))
205 . S X="SARR("_STG_")"
206 . S @X=FNAME_U_LEVEL_U_FNO
207 . K ARR(FNO)
208 . Q
209SC3 ; 3RD PASS. BUILD OUTPUT ARAY
210 S NODE="SARR"
211 F S NODE=$Q(@NODE) Q:NODE="" D
212 . S X=@NODE
213 . S TOT=TOT+1
214 . S FNAME=$P(X,U)
215 . S LEVEL=$P(X,U,2)
216 . S FNO=$P(X,U,3)
217 . S OUT(TOT)=$E(" ",1,LEVEL)_FNAME_" ("_FNO_")"
218 . Q
219 Q
220 ;
221PASS1 ; PASS 1. BUILD THE ARRAY OF ALL SUBFILES
222 N FNO S FNO=0
223 F S FNO=$O(^DD(FIEN,"SB",FNO)) Q:'FNO D
224 . S ARR(FNO)=""
225 . I '$D(^DD(FNO,"SB")) Q
226 . N FIEN S FIEN=FNO
227 . D PASS1 ; RECURSION!!
228 . Q
229 Q
230 ;
231ASTG(STG) ; CONVERT STRING FROM FILE NUMBERS TO FILE NAMES
232 N PCE,LEV,FNO,NAME
233 S LEV=$L(STG,",")
234 F PCE=1:1:LEV S FNO=+$P(STG,",",PCE) D I '$L(STG) Q ""
235 . S NAME=$O(^DD(FNO,0,"NM",""))
236 . I $E(NAME)="*" S NAME=$E(NAME,2,99)
237 . I '$L(NAME) S STG="" Q
238 . S $P(STG,",",PCE)=""""_NAME_""""
239 . Q
240 Q STG
241 ;
242FLIST(OUT,FILE,MODE) ;EP - GIVEN A FILE RETURN THE FILEDS IN AN ARRAY MODE=0: NUMERIC ORDER, MODE=1: ALPHA ORDER
243 ; ONLY NON MULTIPLES AND WORD PROCESSING FIELDS ARE LISTED
244 N FLD,TOT,NAME,ARR,SS,%,WP
245 S FLD=0,TOT=0
246F1 F S FLD=$O(^DD(FILE,FLD)) Q:'FLD D ; PASS 1
247 . S STG=$G(^DD(FILE,FLD,0)) I '$L(STG) Q
248 . S %=$P(STG,U,2)
249 . I %,$P($G(^DD(%,.01,0)),U,2)'["W" Q ; EXCLUDE ALL MULTIPLE FIELDS EXCEPT WORD PROCESSING FIELDS
250 . S WP=0 I % S WP=1
251 . S NAME=$P(STG,U)
252 . S SS=FLD
253 . I $G(MODE)=1 S %=NAME S:$E(%)="*" %=$E(%,2,99) S SS=%
254 . S ARR(SS)=FLD_U_NAME_U_WP
255 . Q
256F2 S SS=""
257 F S SS=$O(ARR(SS)) Q:SS="" D
258 . S TOT=TOT+1
259 . S %=ARR(SS)
260 . S OUT(TOT)=$P(%,U,2)_" ["_+%_"]"_$S($P(%,U,3):" (word processing)",1:"")
261 . K ARR(SS)
262 . Q
263 Q
264 ;
Note: See TracBrowser for help on using the repository browser.