- BMXADO2 ; IHS/CIHA/GIS - BMX ADO RECORDSET UTILS ;
- ;;4.0;BMX;;JUN 28, 2010
- ;
- ;
- GEN(BMXY,BMXF) ;EP - Generate an ADO Schema string from a list of fields
- ;BMXY Is an out-parameter called by reference.
- ;On return, BMXY will be a zero-based one-dimensional array each node of which will
- ;contain the schema corresponding to the fields info in BMXF
- ;
- ;BMXF is an in-parameter called by reference.
- ;On input, BMXF will contain the field info on which to build the schema string.
- ;
- ;Field info in BMXF is arranged in a zero-based one-dimensional array.
- ;Node 0 of BMXF contains the KEYFIELDNAME^FILENUMBER^READONLY
- ;where KEYFIELDNAME is the name of the unique key field in the database and
- ;FILENUMBER is the FileMan file number and
- ;READONLY denotes whether the entire recordset is updateable.
- ;
- ;Each subsequent node of the BMXF arrray contains field info in the form
- ;1FILE#^2FIELD#^3LENGTH^4DATATYPE^5ALIAS^6READONLY^7KEYFIELD^8NULLOK
- ;If FILE# AND FIELD# are defined, the LENGTH and DATATYPE will be taken from the FileMan data dictionary
- ;If ALIAS is defined, the schema string will use ALIAS as the column name
- ;READONLY, KEYFIELD and NULLOK are binary fields. Note that there should be only one field
- ;in the recordset having KEYFIELD=TRUE
- ;
- ;New column info format is @@@meta@@@KEYFIELD|FILE#
- ; For each field: ^1FILE#|2FIELD#|3DATATYPE|4LENGTH|5FIELDNAME|6READONLY|7KEYFIELD|8NULL ALLOWED
- ;example:
- ;BMXY(0)="@@@meta@@@BMXIEN|2160010^"
- ;BMXY(1)="2160010|.001|I|10|BMXIEN|TRUE|TRUE|FALSE^"
- ;
- S BMXY(0)="@@@meta@@@"_$G(BMXF(0))
- N BMXI,BMXS,BMXFM,BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL
- S BMXI=0
- F S BMXI=$O(BMXF(BMXI)) Q:'+BMXI D
- . N BMXFM,BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL
- . S (BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL)=""
- . S BMXFM=0 ;Flag indicating whether BMXF(BMXI) is a FileMan field
- . S BMXY(BMXI)=""
- . I BMXF(BMXI) S BMXY(BMXI)=$P(BMXF(BMXI),U,1,2) S BMXFM=1
- . I BMXFM D ;Look in ^DD for attributes
- . . S BMXDD=$G(^DD($P(BMXF(BMXI),U),$P(BMXF(BMXI),U,2),0))
- . . ;column name
- . . S BMXNAM=$P(BMXDD,U)
- . . S BMXNAM=$TR(BMXNAM," ","_")
- . . ;Data type
- . . I $P(BMXDD,U,2)["P" S BMXDD=$$PTYPE(BMXDD)
- . . S BMXTYP=$P(BMXDD,U,2)
- . . S BMXTYP=$S(BMXTYP["F":"T",BMXTYP["S":"T",BMXTYP["D":"D")
- . . I BMXTYP["N" S BMXTYP=$S($P(BMXTYP,",",2)>0:"N",1:"I")
- . . ;default columnn lengths based on type
- . . I BMXTYP="N"!(BMXTYP="I") S BMXLEN=$P(BMXDD,U,2),BMXLEN=$P(BMXLEN,","),BMXLEN=$E(BMXLEN,3,$L(BMXLEN))
- . . I BMXTYP="I" S BMXLEN2=$P(BMXDD,U,2),BMXLEN2=$P(BMXLEN,",",2),BMXLEN=BMXLEN+BMXLEN2+1
- . . I BMXTYP="T" S BMXLEN=0
- . . I BMXTYP="D" S BMXLEN=30
- . . S BMXNULL="TRUE" S:$P(BMXDD,U,2)["R" BMXNULL="FALSE"
- . ;Look in BMXF for user-specified attributes
- . S:$P(BMXF(BMXI),U,5)]"" BMXNAM=$P(BMXF(BMXI),U,5) ;Alias
- . ;Set KEY, NULL and READONLY
- . S BMXNULL="TRUE",BMXREAD="TRUE",BMXKEY="FALSE"
- . I $P(BMXF(BMXI),U,7)="TRUE" S BMXKEY="TRUE",BMXNULL="FALSE",BMXREAD="TRUE"
- . E S:$P(BMXF(BMXI),U,8)]"" BMXNULL=$P(BMXF(BMXI),U,8) S:$P(BMXF(BMXI),U,6)]"" BMXREAD=$P(BMXF(BMXI),U,6)
- . ;Set BMXY node
- . S $P(BMXY(BMXI),"|",3)=BMXTYP
- . S $P(BMXY(BMXI),"|",4)=BMXLEN
- . S $P(BMXY(BMXI),"|",5)=BMXNAM
- . S $P(BMXY(BMXI),"|",6)=BMXREAD
- . S $P(BMXY(BMXI),"|",7)=BMXKEY
- . S $P(BMXY(BMXI),"|",8)=BMXNULL
- ;
- Q
- PTYPE(BMXDD) ;
- ;Traverse pointer chain to retrieve data type of pointed-to field
- N BMXFILE
- I $P(BMXDD,U,2)'["P" Q BMXDD
- S BMXFILE=$P(BMXDD,U,2)
- S BMXFILE=+$P(BMXFILE,"P",2)
- S BMXDD=$G(^DD(BMXFILE,".01",0))
- S BMXDD=$$PTYPE(BMXDD)
- Q BMXDD
- BMXADO2 ; IHS/CIHA/GIS - BMX ADO RECORDSET UTILS ;
- +1 ;;4.0;BMX;;JUN 28, 2010
- +2 ;
- +3 ;
- GEN(BMXY,BMXF) ;EP - Generate an ADO Schema string from a list of fields
- +1 ;BMXY Is an out-parameter called by reference.
- +2 ;On return, BMXY will be a zero-based one-dimensional array each node of which will
- +3 ;contain the schema corresponding to the fields info in BMXF
- +4 ;
- +5 ;BMXF is an in-parameter called by reference.
- +6 ;On input, BMXF will contain the field info on which to build the schema string.
- +7 ;
- +8 ;Field info in BMXF is arranged in a zero-based one-dimensional array.
- +9 ;Node 0 of BMXF contains the KEYFIELDNAME^FILENUMBER^READONLY
- +10 ;where KEYFIELDNAME is the name of the unique key field in the database and
- +11 ;FILENUMBER is the FileMan file number and
- +12 ;READONLY denotes whether the entire recordset is updateable.
- +13 ;
- +14 ;Each subsequent node of the BMXF arrray contains field info in the form
- +15 ;1FILE#^2FIELD#^3LENGTH^4DATATYPE^5ALIAS^6READONLY^7KEYFIELD^8NULLOK
- +16 ;If FILE# AND FIELD# are defined, the LENGTH and DATATYPE will be taken from the FileMan data dictionary
- +17 ;If ALIAS is defined, the schema string will use ALIAS as the column name
- +18 ;READONLY, KEYFIELD and NULLOK are binary fields. Note that there should be only one field
- +19 ;in the recordset having KEYFIELD=TRUE
- +20 ;
- +21 ;New column info format is @@@meta@@@KEYFIELD|FILE#
- +22 ; For each field: ^1FILE#|2FIELD#|3DATATYPE|4LENGTH|5FIELDNAME|6READONLY|7KEYFIELD|8NULL ALLOWED
- +23 ;example:
- +24 ;BMXY(0)="@@@meta@@@BMXIEN|2160010^"
- +25 ;BMXY(1)="2160010|.001|I|10|BMXIEN|TRUE|TRUE|FALSE^"
- +26 ;
- +27 SET BMXY(0)="@@@meta@@@"_$GET(BMXF(0))
- +28 NEW BMXI,BMXS,BMXFM,BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL
- +29 SET BMXI=0
- +30 FOR
- SET BMXI=$ORDER(BMXF(BMXI))
- IF '+BMXI
- QUIT
- Begin DoDot:1
- +31 NEW BMXFM,BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL
- +32 SET (BMXDD,BMXTYP,BMXLEN,BMXLEN2,BMXNAM,BMXKEY,BMXREAD,BMXNULL)=""
- +33 ;Flag indicating whether BMXF(BMXI) is a FileMan field
- SET BMXFM=0
- +34 SET BMXY(BMXI)=""
- +35 IF BMXF(BMXI)
- SET BMXY(BMXI)=$PIECE(BMXF(BMXI),U,1,2)
- SET BMXFM=1
- +36 ;Look in ^DD for attributes
- IF BMXFM
- Begin DoDot:2
- +37 SET BMXDD=$GET(^DD($PIECE(BMXF(BMXI),U),$PIECE(BMXF(BMXI),U,2),0))
- +38 ;column name
- +39 SET BMXNAM=$PIECE(BMXDD,U)
- +40 SET BMXNAM=$TRANSLATE(BMXNAM," ","_")
- +41 ;Data type
- +42 IF $PIECE(BMXDD,U,2)["P"
- SET BMXDD=$$PTYPE(BMXDD)
- +43 SET BMXTYP=$PIECE(BMXDD,U,2)
- +44 SET BMXTYP=$SELECT(BMXTYP["F":"T",BMXTYP["S":"T",BMXTYP["D":"D")
- +45 IF BMXTYP["N"
- SET BMXTYP=$SELECT($PIECE(BMXTYP,",",2)>0:"N",1:"I")
- +46 ;default columnn lengths based on type
- +47 IF BMXTYP="N"!(BMXTYP="I")
- SET BMXLEN=$PIECE(BMXDD,U,2)
- SET BMXLEN=$PIECE(BMXLEN,",")
- SET BMXLEN=$EXTRACT(BMXLEN,3,$LENGTH(BMXLEN))
- +48 IF BMXTYP="I"
- SET BMXLEN2=$PIECE(BMXDD,U,2)
- SET BMXLEN2=$PIECE(BMXLEN,",",2)
- SET BMXLEN=BMXLEN+BMXLEN2+1
- +49 IF BMXTYP="T"
- SET BMXLEN=0
- +50 IF BMXTYP="D"
- SET BMXLEN=30
- +51 SET BMXNULL="TRUE"
- IF $PIECE(BMXDD,U,2)["R"
- SET BMXNULL="FALSE"
- End DoDot:2
- +52 ;Look in BMXF for user-specified attributes
- +53 ;Alias
- IF $PIECE(BMXF(BMXI),U,5)]""
- SET BMXNAM=$PIECE(BMXF(BMXI),U,5)
- +54 ;Set KEY, NULL and READONLY
- +55 SET BMXNULL="TRUE"
- SET BMXREAD="TRUE"
- SET BMXKEY="FALSE"
- +56 IF $PIECE(BMXF(BMXI),U,7)="TRUE"
- SET BMXKEY="TRUE"
- SET BMXNULL="FALSE"
- SET BMXREAD="TRUE"
- +57 IF '$TEST
- IF $PIECE(BMXF(BMXI),U,8)]""
- SET BMXNULL=$PIECE(BMXF(BMXI),U,8)
- IF $PIECE(BMXF(BMXI),U,6)]""
- SET BMXREAD=$PIECE(BMXF(BMXI),U,6)
- +58 ;Set BMXY node
- +59 SET $PIECE(BMXY(BMXI),"|",3)=BMXTYP
- +60 SET $PIECE(BMXY(BMXI),"|",4)=BMXLEN
- +61 SET $PIECE(BMXY(BMXI),"|",5)=BMXNAM
- +62 SET $PIECE(BMXY(BMXI),"|",6)=BMXREAD
- +63 SET $PIECE(BMXY(BMXI),"|",7)=BMXKEY
- +64 SET $PIECE(BMXY(BMXI),"|",8)=BMXNULL
- End DoDot:1
- +65 ;
- +66 QUIT
- PTYPE(BMXDD) ;
- +1 ;Traverse pointer chain to retrieve data type of pointed-to field
- +2 NEW BMXFILE
- +3 IF $PIECE(BMXDD,U,2)'["P"
- QUIT BMXDD
- +4 SET BMXFILE=$PIECE(BMXDD,U,2)
- +5 SET BMXFILE=+$PIECE(BMXFILE,"P",2)
- +6 SET BMXDD=$GET(^DD(BMXFILE,".01",0))
- +7 SET BMXDD=$$PTYPE(BMXDD)
- +8 QUIT BMXDD
