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
