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