BMXADO ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
;;4.0;BMX;**3**;JUN 28, 2010;Build 2
; SS^BMXADO: RPC EP FROM WINDOWS/WEB APP TO GENERATE A SCHEMEA STRING (& OPTIONALLY, A DATA SET AS WELL)
; THE SCHEMA DEFINITION AND MAP IS STORED IN THE 'BMX ADO SCHEMA' FILE
; THIS ROUTINE GENERATES THE SCHEMA STRING. BMXADOV GENERATES THE DATA SET THAT GOES WITH THE SCHEMA STRING.
; IF THERE IS AN ERROR, XXX(1) WILL CONTAIN "ERROR|msg"_$C(30) WHERE 'msg' IS THE ERROR MESSAGE
; E.G."ERROR|Invalid schema IEN"
;
;
SSD(OUT,SIEN,DAS,VSTG,JSTG) ;Debug entry point
;D DEBUG^%Serenji("SSD^BMXADO(.OUT,SIEN,DAS,VSTG,JSTG)") ; DEBUGGER ENTRY POINT
Q
;
;
SS(OUT,SIEN,DAS,VSTG,JSTG) ; EP - RETURN THE SCHEMA STRING IN AN ARRAY
; OUT=OUTPUT VARIABLE (PASSED BY REFERENCE)
; THE OUTPUT ARRAY IS GENERATED FROM DATA IN THE 'BMX ADO SCHEMA' FILE AND THE FILEMAN DATABASE
; RECORDS ARE SEPARATED WITH $C(30). FIELDS ARE SEPARATED BY "^". FIELD PROPERTIES ARE SEPARATED BY "|".
; ONE RECORD PER OUTPUT NODE.
; 1ST RECORD IS THE "INTRODUCTION RECORD": "@@@meta@@@BMXIEN|FILE #|DA STRING"
; THE SECOND RECORD IS THE HEADER RECORD. THE REST ARE THE DATA RECORDS
; RECORD FORMAT: FILE#|FIELD#|DATA TYPE|LENGTH|FIELDNAME|READONLY|KEYFIELD|NULLOK_$C(30)
; SIEN=SCHEMA NAME OR IEN FROM BMX ADO SCHEMA FILE
; DAS= "DA" STRING: STRING FOR DEFINING PARENT FILES
; EXAMPLE: "4,8," CORRESPONDS TO DA(2), DA(1).
; PRIMARILY USED AS A "SEED" FOR RE-ENTRY - IF INDEX IS PRESENT.
; IF NOT A SEED, DO NOT INCLUDE THE BOTTOM LEVEL IEN: DA; E.G., "4,8,"
; DO NOT CONFUSE WITH "IENS STRING" OF FILEMAN SILENT CALLS
; VSTG=VIEW STRING INSTRUCTIONS (SEE BMXADOV FOR DETAILS)
; JSTG=JOIN STRING INSTRUCTIONS (SEE BMXADOVJ FOR DETAILS)
;
N X,Y,DIC,ERR
S OUT=$NA(^TMP("BMX ADO",$J)) K @OUT ; DEFINE THE OUTPUT ARRAY CLOSED REFERENCE
X ("S "_$C(68)_"UZ(0)=$C(64)") ; INSURE PRIVELEGES
S X="MERR^BMXADO",@^%ZOSF("TRAP") ; SET MUMPS ERROR TRAP
I '$L(SIEN) S ERR="Missing schema ID" D ERR(ERR) Q
I 'SIEN S DIC="^BMXADO(",DIC(0)="M",X=SIEN D ^DIC S SIEN=+Y I Y=-1 S ERR="Invalid schema ID" D ERR(ERR) Q
I '$D(^BMXADO(SIEN,0)) S ERR="Invalid/missing schema" D ERR(ERR) Q ; SCHEMA MUST EXIST
N FIEN,FLDIEN,TOT,STG,B,C,X,%,LEVEL,Y,SF
S FIEN=$P(^BMXADO(SIEN,0),U,2)
I '$D(^DD(FIEN,0)) S ERR="Invalid/missing file number in schema file" D ERR(ERR) Q ; INVALID FILE NUMBER
S SF=$$CKSUB(FIEN,DAS) I SF=-1 S ERR="Invalid DA string" D ERR(ERR) Q ; INVALID DA STRING
S C=",",B="|",TOT=0 ; THESE LOCALS, ALONG WITH KERNEL VARIABLES, ARE ALWAYS AVAILABLE TO ALL ROUTINES AND SUBROUTINES
JEP ; EP-RECURSION RE-ENTRY POINT FOR JOINS
I $G(SUB),$G(SF) S ERR="Invalid request" D ERR(ERR) Q ; CAN'T DO JOIN WITH A SUBFILE AS THE PRIMARY FILE
S TOT=TOT+1,@OUT@(TOT)="@@@meta@@@BMXIEN"_B_FIEN_B_DAS_U
I $G(SUB) S TOT=TOT+1,@OUT@(TOT)=FIEN_"|.0001|N|15|DA(1)|TRUE|FALSE|FALSE^"
I $G(SF) D SFH(SF) ; SUBFILE HEADERS
S TOT=TOT+1,@OUT@(TOT)=FIEN_"|.001|N|15|BMXIEN|TRUE|TRUE|FALSE^" ; KEY FIELD PART OF HEADER RECORD
S FLDIEN=0
F S FLDIEN=$O(^BMXADO(SIEN,1,FLDIEN)) Q:'FLDIEN S STG=$G(^BMXADO(SIEN,1,FLDIEN,0)) I $L(STG) D ; REST OF HEADER RECORD
. S X=FIEN_B_$P(STG,U)_B_$P(STG,U,2)_B_$P(STG,U,3)_B_$P(STG,U,4)_B
. S %=$S($P(STG,U,5):"TRUE",$P($G(^BMXADO(+$G(SIEN),0)),U,3):"TRUE",1:"FALSE") S X=X_%_B ; READ ONLY
. S %=$S($P(STG,U,6):"TRUE",1:"FALSE") S X=X_%_B ; THIS IS A KEY FIELD
. S %=$S($P(STG,U,7):"TRUE",1:"FALSE") S X=X_%_U ; NULL VALUE IS OK (NOT MANDATORY FOR TRANSACTION)
. S TOT=TOT+1
. S @OUT@(TOT)=X
. Q
I TOT'>2 Q ; NOTHING TO PROCESS
S %=@OUT@(TOT) I $E(%,$L(%))=U S $E(%,$L(%))=$C(30),@OUT@(TOT)=% ; END OF RECORD MARKER
I $G(VSTG)="",$G(DFLD)=.001 S VSTG="~~~" ; SIMPLE LOOKUP INTO DETAILS FILE BY IEN
I '$L($G(VSTG)) Q ; REQUEST IS FOR SCHEMA ONLY - NO DATA
DATASET S VSTG=SIEN_"~"_DAS_"~"_VSTG
I $O(^TMP("BMX JOIN",$J,1,+$G(SDETAIL),0)) D JVIEW Q ; JOIN ITERATION ; NO SUPPORT FOR EXTENDED JOINS
D VIEW^BMXADOV(.OUT,VSTG,.TOT) ; APPEND A DATA SET TO A SCHEMA STRING
I '$L($G(JSTG)) S JSTG=$P(VSTG,"~",11,999) ; INCLUDED FOR BKWD COMPATIBILITY ;JOIN INSTRUCTIONS SPAN MULTIPLE ~ PIECES (11,999) BECAUSE OF POSSIBLE NESTED VSTG
I $L(JSTG) D JOIN^BMXADOVJ(SIEN,JSTG) ; ADD DATA SET(S) TO FULFIL THE JOIN REQUEST
Q
;
JVIEW ; JOIN VIEW - SET XCNT AND RESET THE VSTG
N XCNT,DA,NODE,%
S NODE=999999999999
F S NODE=$O(@OUT@(NODE),-1) Q:'NODE I @OUT@(NODE)["|.001|" Q
I 'NODE Q ; INVALID SCHEMA - JOIN CANCELLED
I '$L($P(VSTG,"~",3)),'$G(SUB),$G(DFLD)'=.001 Q ; THERE MUST BE AN INDEX OR SUBFILE FOR A JOIN TO TAKE PLACE
D JFLD^BMXADOVJ ; STUFF VALUES FOR JOIN FLDS INTO INTRO SEGMENT OF THE SCHEMA
S XCNT=NODE
S DA=0
F S DA=$O(^TMP("BMX JOIN",$J,1,SDETAIL,DA)) Q:'DA D D VIEW^BMXADOV(.OUT,VSTG,.TOT) ; APPEND JOINED DATA SETS TO A SCHEMA STRING
. I $P(VSTG,"~",3)="AA",$L($P(VSTG,"~",10)) D Q
.. S %=$P(VSTG,"~",10)
.. S $P(%,"|",1)=DA
.. S $P(VSTG,"~",10)=%
.. Q
. I $G(SUB) S DAS=DA_",",VSTG=SDETAIL_"~"_DA_",~~" Q ; SUBFILE ITERATOR
. I $P(VSTG,"~",3)="AA",$G(FIEN)=9000011 S $P(VSTG,"~",4,5)=DA_"~"_DA Q ; PROBLEM LIST ITERATOR
. S $P(VSTG,"~",4,5)=DA_"~"_DA ; SINGLE IEN ITERATOR
. Q
Q
;
SFH(DAS) ; SUBFILE HEADERS
N L,LEV,PCE,X,%,Z,FLD
S Z="000000000",L=$L(DAS,",")
F PCE=1:1:L-1 D
. S LEV=(L+1)-PCE
. S FLD="."_$E(Z,1,LEV+1)_1
. S TOT=TOT+1
. S @OUT@(TOT)=FIEN_B_FLD_"|I|10|BMXIEN"_(LEV-1)_"|TRUE|TRUE|FALSE"_U ; FIX
. Q
Q
;
CKSUB(FILE,DAS) ; CHECK THE DA STRING FOR VALIDITY AND MAKE THE DA ARRAY
N LEVEL,FIEN
S FIEN=FILE
F LEVEL=1:1 S FIEN=$G(^DD(FIEN,0,"UP")) Q:'FIEN ; COUNT THE LEVELS
I LEVEL'=$L($G(DAS),",") Q -1 ; LEVEL MATCHES DA STRING
I LEVEL=1 Q "" ; INVALID DA STRING
Q DAS
;
LINE(FILE) ; GET FIELD VALUES
N LINE,NODE,STG,DIR,FLD,PF,SET,X,DS,DP
S LINE=""
S NODE=2,Y="" F S NODE=$O(ARR(NODE)) Q:'NODE S STG=ARR(NODE) I $L(STG) D I Y=U Q
. S FLD=$P(STG,B,2) I 'FLD S Y=U Q
. I $P(STG,B,6)="TRUE" Q ; READ ONLY
. S DIR("A")=$P(STG,B,5) I '$L(DIR("A")) S Y=U Q
. S X=$P($G(^DD(+$G(FILE),FLD,0)),U,2)
. I X["P" D Q
.. S PF=+$P(X,"P",2) I 'PF S Y=U Q
.. S DIR(0)="P^"_PF_":EQMZ"
.. D DIR
.. Q
. I X["S" D Q
.. S DIR(0)="S^"_$P(^DD(FILE,FLD,0),U,3)
.. D DIR
.. Q
. I X["D" D Q
.. S DS=$P(^DD(FILE,FLD,0),U,5)
.. I DS'["%DT=""" S DIR(0)="D^::EX" D DIR Q
.. S DP=$P(DS,"%DT="_$C(34),2) S DP=$P(DP,$C(34,32),1)
.. S DIR(0)="D^::"_DP
.. D DIR
.. Q
. S DIR="F"
. D DIR
. Q
Q LINE
;
DIR D ^DIR
I Y?1."^" S Y=U Q
I Y?1.N1"^".E S Y="`"_+Y
S LINE=LINE_U_Y
Q
;
MERR ; MUMPS ERROR TRAP
N X
X ("S X=$"_"ZE")
S X="MUMPS error: """_X_""""
D ERR(X)
Q
;
ERR(ERR) ;EP - BMX ADO SCHEMA ERROR PROCESSOR
N X
S X="ERROR|"_ERR_$C(30)
S @OUT@(1)=X
Q
;
BMXADO ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
+1 ;;4.0;BMX;**3**;JUN 28, 2010;Build 2
+2 ; SS^BMXADO: RPC EP FROM WINDOWS/WEB APP TO GENERATE A SCHEMEA STRING (& OPTIONALLY, A DATA SET AS WELL)
+3 ; THE SCHEMA DEFINITION AND MAP IS STORED IN THE 'BMX ADO SCHEMA' FILE
+4 ; THIS ROUTINE GENERATES THE SCHEMA STRING. BMXADOV GENERATES THE DATA SET THAT GOES WITH THE SCHEMA STRING.
+5 ; IF THERE IS AN ERROR, XXX(1) WILL CONTAIN "ERROR|msg"_$C(30) WHERE 'msg' IS THE ERROR MESSAGE
+6 ; E.G."ERROR|Invalid schema IEN"
+7 ;
+8 ;
SSD(OUT,SIEN,DAS,VSTG,JSTG) ;Debug entry point
+1 ;D DEBUG^%Serenji("SSD^BMXADO(.OUT,SIEN,DAS,VSTG,JSTG)") ; DEBUGGER ENTRY POINT
+2 QUIT
+3 ;
+4 ;
SS(OUT,SIEN,DAS,VSTG,JSTG) ; EP - RETURN THE SCHEMA STRING IN AN ARRAY
+1 ; OUT=OUTPUT VARIABLE (PASSED BY REFERENCE)
+2 ; THE OUTPUT ARRAY IS GENERATED FROM DATA IN THE 'BMX ADO SCHEMA' FILE AND THE FILEMAN DATABASE
+3 ; RECORDS ARE SEPARATED WITH $C(30). FIELDS ARE SEPARATED BY "^". FIELD PROPERTIES ARE SEPARATED BY "|".
+4 ; ONE RECORD PER OUTPUT NODE.
+5 ; 1ST RECORD IS THE "INTRODUCTION RECORD": "@@@meta@@@BMXIEN|FILE #|DA STRING"
+6 ; THE SECOND RECORD IS THE HEADER RECORD. THE REST ARE THE DATA RECORDS
+7 ; RECORD FORMAT: FILE#|FIELD#|DATA TYPE|LENGTH|FIELDNAME|READONLY|KEYFIELD|NULLOK_$C(30)
+8 ; SIEN=SCHEMA NAME OR IEN FROM BMX ADO SCHEMA FILE
+9 ; DAS= "DA" STRING: STRING FOR DEFINING PARENT FILES
+10 ; EXAMPLE: "4,8," CORRESPONDS TO DA(2), DA(1).
+11 ; PRIMARILY USED AS A "SEED" FOR RE-ENTRY - IF INDEX IS PRESENT.
+12 ; IF NOT A SEED, DO NOT INCLUDE THE BOTTOM LEVEL IEN: DA; E.G., "4,8,"
+13 ; DO NOT CONFUSE WITH "IENS STRING" OF FILEMAN SILENT CALLS
+14 ; VSTG=VIEW STRING INSTRUCTIONS (SEE BMXADOV FOR DETAILS)
+15 ; JSTG=JOIN STRING INSTRUCTIONS (SEE BMXADOVJ FOR DETAILS)
+16 ;
+17 NEW X,Y,DIC,ERR
+18 ; DEFINE THE OUTPUT ARRAY CLOSED REFERENCE
SET OUT=$NAME(^TMP("BMX ADO",$JOB))
KILL @OUT
+19 ; INSURE PRIVELEGES
XECUTE ("S "_$CHAR(68)_"UZ(0)=$C(64)")
+20 ; SET MUMPS ERROR TRAP
SET X="MERR^BMXADO"
SET @^%ZOSF("TRAP")
+21 IF '$LENGTH(SIEN)
SET ERR="Missing schema ID"
DO ERR(ERR)
QUIT
+22 IF 'SIEN
SET DIC="^BMXADO("
SET DIC(0)="M"
SET X=SIEN
DO ^DIC
SET SIEN=+Y
IF Y=-1
SET ERR="Invalid schema ID"
DO ERR(ERR)
QUIT
+23 ; SCHEMA MUST EXIST
IF '$DATA(^BMXADO(SIEN,0))
SET ERR="Invalid/missing schema"
DO ERR(ERR)
QUIT
+24 NEW FIEN,FLDIEN,TOT,STG,B,C,X,%,LEVEL,Y,SF
+25 SET FIEN=$PIECE(^BMXADO(SIEN,0),U,2)
+26 ; INVALID FILE NUMBER
IF '$DATA(^DD(FIEN,0))
SET ERR="Invalid/missing file number in schema file"
DO ERR(ERR)
QUIT
+27 ; INVALID DA STRING
SET SF=$$CKSUB(FIEN,DAS)
IF SF=-1
SET ERR="Invalid DA string"
DO ERR(ERR)
QUIT
+28 ; THESE LOCALS, ALONG WITH KERNEL VARIABLES, ARE ALWAYS AVAILABLE TO ALL ROUTINES AND SUBROUTINES
SET C=","
SET B="|"
SET TOT=0
JEP ; EP-RECURSION RE-ENTRY POINT FOR JOINS
+1 ; CAN'T DO JOIN WITH A SUBFILE AS THE PRIMARY FILE
IF $GET(SUB)
IF $GET(SF)
SET ERR="Invalid request"
DO ERR(ERR)
QUIT
+2 SET TOT=TOT+1
SET @OUT@(TOT)="@@@meta@@@BMXIEN"_B_FIEN_B_DAS_U
+3 IF $GET(SUB)
SET TOT=TOT+1
SET @OUT@(TOT)=FIEN_"|.0001|N|15|DA(1)|TRUE|FALSE|FALSE^"
+4 ; SUBFILE HEADERS
IF $GET(SF)
DO SFH(SF)
+5 ; KEY FIELD PART OF HEADER RECORD
SET TOT=TOT+1
SET @OUT@(TOT)=FIEN_"|.001|N|15|BMXIEN|TRUE|TRUE|FALSE^"
+6 SET FLDIEN=0
+7 ; REST OF HEADER RECORD
FOR
SET FLDIEN=$ORDER(^BMXADO(SIEN,1,FLDIEN))
IF 'FLDIEN
QUIT
SET STG=$GET(^BMXADO(SIEN,1,FLDIEN,0))
IF $LENGTH(STG)
Begin DoDot:1
+8 SET X=FIEN_B_$PIECE(STG,U)_B_$PIECE(STG,U,2)_B_$PIECE(STG,U,3)_B_$PIECE(STG,U,4)_B
+9 ; READ ONLY
SET %=$SELECT($PIECE(STG,U,5):"TRUE",$PIECE($GET(^BMXADO(+$GET(SIEN),0)),U,3):"TRUE",1:"FALSE")
SET X=X_%_B
+10 ; THIS IS A KEY FIELD
SET %=$SELECT($PIECE(STG,U,6):"TRUE",1:"FALSE")
SET X=X_%_B
+11 ; NULL VALUE IS OK (NOT MANDATORY FOR TRANSACTION)
SET %=$SELECT($PIECE(STG,U,7):"TRUE",1:"FALSE")
SET X=X_%_U
+12 SET TOT=TOT+1
+13 SET @OUT@(TOT)=X
+14 QUIT
End DoDot:1
+15 ; NOTHING TO PROCESS
IF TOT'>2
QUIT
+16 ; END OF RECORD MARKER
SET %=@OUT@(TOT)
IF $EXTRACT(%,$LENGTH(%))=U
SET $EXTRACT(%,$LENGTH(%))=$CHAR(30)
SET @OUT@(TOT)=%
+17 ; SIMPLE LOOKUP INTO DETAILS FILE BY IEN
IF $GET(VSTG)=""
IF $GET(DFLD)=.001
SET VSTG="~~~"
+18 ; REQUEST IS FOR SCHEMA ONLY - NO DATA
IF '$LENGTH($GET(VSTG))
QUIT
DATASET SET VSTG=SIEN_"~"_DAS_"~"_VSTG
+1 ; JOIN ITERATION ; NO SUPPORT FOR EXTENDED JOINS
IF $ORDER(^TMP("BMX JOIN",$JOB,1,+$GET(SDETAIL),0))
DO JVIEW
QUIT
+2 ; APPEND A DATA SET TO A SCHEMA STRING
DO VIEW^BMXADOV(.OUT,VSTG,.TOT)
+3 ; INCLUDED FOR BKWD COMPATIBILITY ;JOIN INSTRUCTIONS SPAN MULTIPLE ~ PIECES (11,999) BECAUSE OF POSSIBLE NESTED VSTG
IF '$LENGTH($GET(JSTG))
SET JSTG=$PIECE(VSTG,"~",11,999)
+4 ; ADD DATA SET(S) TO FULFIL THE JOIN REQUEST
IF $LENGTH(JSTG)
DO JOIN^BMXADOVJ(SIEN,JSTG)
+5 QUIT
+6 ;
JVIEW ; JOIN VIEW - SET XCNT AND RESET THE VSTG
+1 NEW XCNT,DA,NODE,%
+2 SET NODE=999999999999
+3 FOR
SET NODE=$ORDER(@OUT@(NODE),-1)
IF 'NODE
QUIT
IF @OUT@(NODE)["|.001|"
QUIT
+4 ; INVALID SCHEMA - JOIN CANCELLED
IF 'NODE
QUIT
+5 ; THERE MUST BE AN INDEX OR SUBFILE FOR A JOIN TO TAKE PLACE
IF '$LENGTH($PIECE(VSTG,"~",3))
IF '$GET(SUB)
IF $GET(DFLD)'=.001
QUIT
+6 ; STUFF VALUES FOR JOIN FLDS INTO INTRO SEGMENT OF THE SCHEMA
DO JFLD^BMXADOVJ
+7 SET XCNT=NODE
+8 SET DA=0
+9 ; APPEND JOINED DATA SETS TO A SCHEMA STRING
FOR
SET DA=$ORDER(^TMP("BMX JOIN",$JOB,1,SDETAIL,DA))
IF 'DA
QUIT
Begin DoDot:1
+10 IF $PIECE(VSTG,"~",3)="AA"
IF $LENGTH($PIECE(VSTG,"~",10))
Begin DoDot:2
+11 SET %=$PIECE(VSTG,"~",10)
+12 SET $PIECE(%,"|",1)=DA
+13 SET $PIECE(VSTG,"~",10)=%
+14 QUIT
End DoDot:2
QUIT
+15 ; SUBFILE ITERATOR
IF $GET(SUB)
SET DAS=DA_","
SET VSTG=SDETAIL_"~"_DA_",~~"
QUIT
+16 ; PROBLEM LIST ITERATOR
IF $PIECE(VSTG,"~",3)="AA"
IF $GET(FIEN)=9000011
SET $PIECE(VSTG,"~",4,5)=DA_"~"_DA
QUIT
+17 ; SINGLE IEN ITERATOR
SET $PIECE(VSTG,"~",4,5)=DA_"~"_DA
+18 QUIT
End DoDot:1
DO VIEW^BMXADOV(.OUT,VSTG,.TOT)
+19 QUIT
+20 ;
SFH(DAS) ; SUBFILE HEADERS
+1 NEW L,LEV,PCE,X,%,Z,FLD
+2 SET Z="000000000"
SET L=$LENGTH(DAS,",")
+3 FOR PCE=1:1:L-1
Begin DoDot:1
+4 SET LEV=(L+1)-PCE
+5 SET FLD="."_$EXTRACT(Z,1,LEV+1)_1
+6 SET TOT=TOT+1
+7 ; FIX
SET @OUT@(TOT)=FIEN_B_FLD_"|I|10|BMXIEN"_(LEV-1)_"|TRUE|TRUE|FALSE"_U
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
CKSUB(FILE,DAS) ; CHECK THE DA STRING FOR VALIDITY AND MAKE THE DA ARRAY
+1 NEW LEVEL,FIEN
+2 SET FIEN=FILE
+3 ; COUNT THE LEVELS
FOR LEVEL=1:1
SET FIEN=$GET(^DD(FIEN,0,"UP"))
IF 'FIEN
QUIT
+4 ; LEVEL MATCHES DA STRING
IF LEVEL'=$LENGTH($GET(DAS),",")
QUIT -1
+5 ; INVALID DA STRING
IF LEVEL=1
QUIT ""
+6 QUIT DAS
+7 ;
LINE(FILE) ; GET FIELD VALUES
+1 NEW LINE,NODE,STG,DIR,FLD,PF,SET,X,DS,DP
+2 SET LINE=""
+3 SET NODE=2
SET Y=""
FOR
SET NODE=$ORDER(ARR(NODE))
IF 'NODE
QUIT
SET STG=ARR(NODE)
IF $LENGTH(STG)
Begin DoDot:1
+4 SET FLD=$PIECE(STG,B,2)
IF 'FLD
SET Y=U
QUIT
+5 ; READ ONLY
IF $PIECE(STG,B,6)="TRUE"
QUIT
+6 SET DIR("A")=$PIECE(STG,B,5)
IF '$LENGTH(DIR("A"))
SET Y=U
QUIT
+7 SET X=$PIECE($GET(^DD(+$GET(FILE),FLD,0)),U,2)
+8 IF X["P"
Begin DoDot:2
+9 SET PF=+$PIECE(X,"P",2)
IF 'PF
SET Y=U
QUIT
+10 SET DIR(0)="P^"_PF_":EQMZ"
+11 DO DIR
+12 QUIT
End DoDot:2
QUIT
+13 IF X["S"
Begin DoDot:2
+14 SET DIR(0)="S^"_$PIECE(^DD(FILE,FLD,0),U,3)
+15 DO DIR
+16 QUIT
End DoDot:2
QUIT
+17 IF X["D"
Begin DoDot:2
+18 SET DS=$PIECE(^DD(FILE,FLD,0),U,5)
+19 IF DS'["%DT="""
SET DIR(0)="D^::EX"
DO DIR
QUIT
+20 SET DP=$PIECE(DS,"%DT="_$CHAR(34),2)
SET DP=$PIECE(DP,$CHAR(34,32),1)
+21 SET DIR(0)="D^::"_DP
+22 DO DIR
+23 QUIT
End DoDot:2
QUIT
+24 SET DIR="F"
+25 DO DIR
+26 QUIT
End DoDot:1
IF Y=U
QUIT
+27 QUIT LINE
+28 ;
DIR DO ^DIR
+1 IF Y?1."^"
SET Y=U
QUIT
+2 IF Y?1.N1"^".E
SET Y="`"_+Y
+3 SET LINE=LINE_U_Y
+4 QUIT
+5 ;
MERR ; MUMPS ERROR TRAP
+1 NEW X
+2 XECUTE ("S X=$"_"ZE")
+3 SET X="MUMPS error: """_X_""""
+4 DO ERR(X)
+5 QUIT
+6 ;
ERR(ERR) ;EP - BMX ADO SCHEMA ERROR PROCESSOR
+1 NEW X
+2 SET X="ERROR|"_ERR_$CHAR(30)
+3 SET @OUT@(1)=X
+4 QUIT
+5 ;
