| [1147] | 1 | BMXADO ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
|
|---|
| 2 | ;;4.1000;BMX;;Apr 17, 2011
|
|---|
| 3 | ; SS^BMXADO: RPC EP FROM WINDOWS/WEB APP TO GENERATE A SCHEMEA STRING (& OPTIONALLY, A DATA SET AS WELL)
|
|---|
| 4 | ; THE SCHEMA DEFINITION AND MAP IS STORED IN THE 'BMX ADO SCHEMA' FILE
|
|---|
| 5 | ; THIS ROUTINE GENERATES THE SCHEMA STRING. BMXADOV GENERATES THE DATA SET THAT GOES WITH THE SCHEMA STRING.
|
|---|
| 6 | ; IF THERE IS AN ERROR, XXX(1) WILL CONTAIN "ERROR|msg"_$C(30) WHERE 'msg' IS THE ERROR MESSAGE
|
|---|
| 7 | ; E.G."ERROR|Invalid schema IEN"
|
|---|
| 8 | ;
|
|---|
| 9 | ;
|
|---|
| 10 | SSD(OUT,SIEN,DAS,VSTG,JSTG) ;Debug entry point
|
|---|
| 11 | ;D DEBUG^%Serenji("SSD^BMXADO(.OUT,SIEN,DAS,VSTG,JSTG)") ; DEBUGGER ENTRY POINT
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | SS(OUT,SIEN,DAS,VSTG,JSTG) ; EP - RETURN THE SCHEMA STRING IN AN ARRAY
|
|---|
| 16 | ; OUT=OUTPUT VARIABLE (PASSED BY REFERENCE)
|
|---|
| 17 | ; THE OUTPUT ARRAY IS GENERATED FROM DATA IN THE 'BMX ADO SCHEMA' FILE AND THE FILEMAN DATABASE
|
|---|
| 18 | ; RECORDS ARE SEPARATED WITH $C(30). FIELDS ARE SEPARATED BY "^". FIELD PROPERTIES ARE SEPARATED BY "|".
|
|---|
| 19 | ; ONE RECORD PER OUTPUT NODE.
|
|---|
| 20 | ; 1ST RECORD IS THE "INTRODUCTION RECORD": "@@@meta@@@BMXIEN|FILE #|DA STRING"
|
|---|
| 21 | ; THE SECOND RECORD IS THE HEADER RECORD. THE REST ARE THE DATA RECORDS
|
|---|
| 22 | ; RECORD FORMAT: FILE#|FIELD#|DATA TYPE|LENGTH|FIELDNAME|READONLY|KEYFIELD|NULLOK_$C(30)
|
|---|
| 23 | ; SIEN=SCHEMA NAME OR IEN FROM BMX ADO SCHEMA FILE
|
|---|
| 24 | ; DAS= "DA" STRING: STRING FOR DEFINING PARENT FILES
|
|---|
| 25 | ; EXAMPLE: "4,8," CORRESPONDS TO DA(2), DA(1).
|
|---|
| 26 | ; PRIMARILY USED AS A "SEED" FOR RE-ENTRY - IF INDEX IS PRESENT.
|
|---|
| 27 | ; IF NOT A SEED, DO NOT INCLUDE THE BOTTOM LEVEL IEN: DA; E.G., "4,8,"
|
|---|
| 28 | ; DO NOT CONFUSE WITH "IENS STRING" OF FILEMAN SILENT CALLS
|
|---|
| 29 | ; VSTG=VIEW STRING INSTRUCTIONS (SEE BMXADOV FOR DETAILS)
|
|---|
| 30 | ; JSTG=JOIN STRING INSTRUCTIONS (SEE BMXADOVJ FOR DETAILS)
|
|---|
| 31 | ;
|
|---|
| 32 | N X,Y,DIC,ERR
|
|---|
| 33 | S OUT=$NA(^TMP("BMX ADO",$J)) K @OUT ; DEFINE THE OUTPUT ARRAY CLOSED REFERENCE
|
|---|
| 34 | X ("S "_$C(68)_"UZ(0)=$C(64)") ; INSURE PRIVELEGES
|
|---|
| 35 | S X="MERR^BMXADO",@^%ZOSF("TRAP") ; SET MUMPS ERROR TRAP
|
|---|
| 36 | I '$L(SIEN) S ERR="Missing schema ID" D ERR(ERR) Q
|
|---|
| 37 | 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
|
|---|
| 38 | I '$D(^BMXADO(SIEN,0)) S ERR="Invalid/missing schema" D ERR(ERR) Q ; SCHEMA MUST EXIST
|
|---|
| 39 | N FIEN,FLDIEN,TOT,STG,B,C,X,%,LEVEL,Y,SF
|
|---|
| 40 | S FIEN=$P(^BMXADO(SIEN,0),U,2)
|
|---|
| 41 | I '$D(^DD(FIEN,0)) S ERR="Invalid/missing file number in schema file" D ERR(ERR) Q ; INVALID FILE NUMBER
|
|---|
| 42 | S SF=$$CKSUB(FIEN,DAS) I SF=-1 S ERR="Invalid DA string" D ERR(ERR) Q ; INVALID DA STRING
|
|---|
| 43 | S C=",",B="|",TOT=0 ; THESE LOCALS, ALONG WITH KERNEL VARIABLES, ARE ALWAYS AVAILABLE TO ALL ROUTINES AND SUBROUTINES
|
|---|
| 44 | JEP ; EP-RECURSION RE-ENTRY POINT FOR JOINS
|
|---|
| 45 | I $G(SUB),$G(SF) S ERR="Invalid request" D ERR(ERR) Q ; CAN'T DO JOIN WITH A SUBFILE AS THE PRIMARY FILE
|
|---|
| 46 | S TOT=TOT+1,@OUT@(TOT)="@@@meta@@@BMXIEN"_B_FIEN_B_DAS_U
|
|---|
| 47 | I $G(SUB) S TOT=TOT+1,@OUT@(TOT)=FIEN_"|.0001|N|15|DA(1)|TRUE|FALSE|FALSE^"
|
|---|
| 48 | I $G(SF) D SFH(SF) ; SUBFILE HEADERS
|
|---|
| 49 | S TOT=TOT+1,@OUT@(TOT)=FIEN_"|.001|N|15|BMXIEN|TRUE|TRUE|FALSE^" ; KEY FIELD PART OF HEADER RECORD
|
|---|
| 50 | S FLDIEN=0
|
|---|
| 51 | 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
|
|---|
| 52 | . S X=FIEN_B_$P(STG,U)_B_$P(STG,U,2)_B_$P(STG,U,3)_B_$P(STG,U,4)_B
|
|---|
| 53 | . S %=$S($P(STG,U,5):"TRUE",$P($G(^BMXADO(+$G(IEN),0)),U,3):"TRUE",1:"FALSE") S X=X_%_B ; READ ONLY
|
|---|
| 54 | . S %=$S($P(STG,U,6):"TRUE",1:"FALSE") S X=X_%_B ; THIS IS A KEY FIELD
|
|---|
| 55 | . S %=$S($P(STG,U,7):"TRUE",1:"FALSE") S X=X_%_U ; NULL VALUE IS OK (NOT MANDATORY FOR TRANSACTION)
|
|---|
| 56 | . S TOT=TOT+1
|
|---|
| 57 | . S @OUT@(TOT)=X
|
|---|
| 58 | . Q
|
|---|
| 59 | I TOT'>2 Q ; NOTHING TO PROCESS
|
|---|
| 60 | S %=@OUT@(TOT) I $E(%,$L(%))=U S $E(%,$L(%))=$C(30),@OUT@(TOT)=% ; END OF RECORD MARKER
|
|---|
| 61 | I $G(VSTG)="",$G(DFLD)=.001 S VSTG="~~~" ; SIMPLE LOOKUP INTO DETAILS FILE BY IEN
|
|---|
| 62 | I '$L($G(VSTG)) Q ; REQUEST IS FOR SCHEMA ONLY - NO DATA
|
|---|
| 63 | DATASET S VSTG=SIEN_"~"_DAS_"~"_VSTG
|
|---|
| 64 | I $O(^TMP("BMX JOIN",$J,1,+$G(SDETAIL),0)) D JVIEW Q ; JOIN ITERATION ; NO SUPPORT FOR EXTENDED JOINS
|
|---|
| 65 | D VIEW^BMXADOV(.OUT,VSTG,.TOT) ; APPEND A DATA SET TO A SCHEMA STRING
|
|---|
| 66 | 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
|
|---|
| 67 | I $L(JSTG) D JOIN^BMXADOVJ(SIEN,JSTG) ; ADD DATA SET(S) TO FULFIL THE JOIN REQUEST
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | JVIEW ; JOIN VIEW - SET XCNT AND RESET THE VSTG
|
|---|
| 71 | N XCNT,DA,NODE,%
|
|---|
| 72 | S NODE=999999999999
|
|---|
| 73 | F S NODE=$O(@OUT@(NODE),-1) Q:'NODE I @OUT@(NODE)["|.001|" Q
|
|---|
| 74 | I 'NODE Q ; INVALID SCHEMA - JOIN CANCELLED
|
|---|
| 75 | I '$L($P(VSTG,"~",3)),'$G(SUB),$G(DFLD)'=.001 Q ; THERE MUST BE AN INDEX OR SUBFILE FOR A JOIN TO TAKE PLACE
|
|---|
| 76 | D JFLD^BMXADOVJ ; STUFF VALUES FOR JOIN FLDS INTO INTRO SEGMENT OF THE SCHEMA
|
|---|
| 77 | S XCNT=NODE
|
|---|
| 78 | S DA=0
|
|---|
| 79 | 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
|
|---|
| 80 | . I $P(VSTG,"~",3)="AA",$L($P(VSTG,"~",10)) D Q
|
|---|
| 81 | .. S %=$P(VSTG,"~",10)
|
|---|
| 82 | .. S $P(%,"|",1)=DA
|
|---|
| 83 | .. S $P(VSTG,"~",10)=%
|
|---|
| 84 | .. Q
|
|---|
| 85 | . I $G(SUB) S DAS=DA_",",VSTG=SDETAIL_"~"_DA_",~~" Q ; SUBFILE ITERATOR
|
|---|
| 86 | . I $P(VSTG,"~",3)="AA",$G(FIEN)=9000011 S $P(VSTG,"~",4,5)=DA_"~"_DA Q ; PROBLEM LIST ITERATOR
|
|---|
| 87 | . S $P(VSTG,"~",4,5)=DA_"~"_DA ; SINGLE IEN ITERATOR
|
|---|
| 88 | . Q
|
|---|
| 89 | Q
|
|---|
| 90 | ;
|
|---|
| 91 | SFH(DAS) ; SUBFILE HEADERS
|
|---|
| 92 | N L,LEV,PCE,X,%,Z,FLD
|
|---|
| 93 | S Z="000000000",L=$L(DAS,",")
|
|---|
| 94 | F PCE=1:1:L-1 D
|
|---|
| 95 | . S LEV=(L+1)-PCE
|
|---|
| 96 | . S FLD="."_$E(Z,1,LEV+1)_1
|
|---|
| 97 | . S TOT=TOT+1
|
|---|
| 98 | . S @OUT@(TOT)=FIEN_B_FLD_"|I|10|BMXIEN"_(LEV-1)_"|TRUE|TRUE|FALSE"_U ; FIX
|
|---|
| 99 | . Q
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
| 102 | CKSUB(FILE,DAS) ; CHECK THE DA STRING FOR VALIDITY AND MAKE THE DA ARRAY
|
|---|
| 103 | N LEVEL,FIEN
|
|---|
| 104 | S FIEN=FILE
|
|---|
| 105 | F LEVEL=1:1 S FIEN=$G(^DD(FIEN,0,"UP")) Q:'FIEN ; COUNT THE LEVELS
|
|---|
| 106 | I LEVEL'=$L($G(DAS),",") Q -1 ; LEVEL MATCHES DA STRING
|
|---|
| 107 | I LEVEL=1 Q "" ; INVALID DA STRING
|
|---|
| 108 | Q DAS
|
|---|
| 109 | ;
|
|---|
| 110 | LINE(FILE) ; GET FIELD VALUES
|
|---|
| 111 | N LINE,NODE,STG,DIR,FLD,PF,SET,X,DS,DP
|
|---|
| 112 | S LINE=""
|
|---|
| 113 | S NODE=2,Y="" F S NODE=$O(ARR(NODE)) Q:'NODE S STG=ARR(NODE) I $L(STG) D I Y=U Q
|
|---|
| 114 | . S FLD=$P(STG,B,2) I 'FLD S Y=U Q
|
|---|
| 115 | . I $P(STG,B,6)="TRUE" Q ; READ ONLY
|
|---|
| 116 | . S DIR("A")=$P(STG,B,5) I '$L(DIR("A")) S Y=U Q
|
|---|
| 117 | . S X=$P($G(^DD(+$G(FILE),FLD,0)),U,2)
|
|---|
| 118 | . I X["P" D Q
|
|---|
| 119 | .. S PF=+$P(X,"P",2) I 'PF S Y=U Q
|
|---|
| 120 | .. S DIR(0)="P^"_PF_":EQMZ"
|
|---|
| 121 | .. D DIR
|
|---|
| 122 | .. Q
|
|---|
| 123 | . I X["S" D Q
|
|---|
| 124 | .. S DIR(0)="S^"_$P(^DD(FILE,FLD,0),U,3)
|
|---|
| 125 | .. D DIR
|
|---|
| 126 | .. Q
|
|---|
| 127 | . I X["D" D Q
|
|---|
| 128 | .. S DS=$P(^DD(FILE,FLD,0),U,5)
|
|---|
| 129 | .. I DS'["%DT=""" S DIR(0)="D^::EX" D DIR Q
|
|---|
| 130 | .. S DP=$P(DS,"%DT="_$C(34),2) S DP=$P(DP,$C(34,32),1)
|
|---|
| 131 | .. S DIR(0)="D^::"_DP
|
|---|
| 132 | .. D DIR
|
|---|
| 133 | .. Q
|
|---|
| 134 | . S DIR="F"
|
|---|
| 135 | . D DIR
|
|---|
| 136 | . Q
|
|---|
| 137 | Q LINE
|
|---|
| 138 | ;
|
|---|
| 139 | DIR D ^DIR
|
|---|
| 140 | I Y?1."^" S Y=U Q
|
|---|
| 141 | I Y?1.N1"^".E S Y="`"_+Y
|
|---|
| 142 | S LINE=LINE_U_Y
|
|---|
| 143 | Q
|
|---|
| 144 | ;
|
|---|
| 145 | MERR ; MUMPS ERROR TRAP
|
|---|
| 146 | N X
|
|---|
| 147 | X ("S X=$"_"ZE")
|
|---|
| 148 | S X="MUMPS error: """_X_""""
|
|---|
| 149 | D ERR(X)
|
|---|
| 150 | Q
|
|---|
| 151 | ;
|
|---|
| 152 | ERR(ERR) ;EP - BMX ADO SCHEMA ERROR PROCESSOR
|
|---|
| 153 | N X
|
|---|
| 154 | S X="ERROR|"_ERR_$C(30)
|
|---|
| 155 | S @OUT@(1)=X
|
|---|
| 156 | Q
|
|---|
| 157 | ;
|
|---|
