source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/BMX41000/routines/BMXADO.m@ 1605

Last change on this file since 1605 was 1147, checked in by Sam Habiel, 14 years ago

Mumps Routines 4 BMX4
File size: 6.6 KB
Line 
1BMXADO ; 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 ;
10SSD(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 ;
15SS(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
44JEP ; 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
63DATASET 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 ;
70JVIEW ; 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 ;
91SFH(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 ;
102CKSUB(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 ;
110LINE(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 ;
139DIR 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 ;
145MERR ; MUMPS ERROR TRAP
146 N X
147 X ("S X=$"_"ZE")
148 S X="MUMPS error: """_X_""""
149 D ERR(X)
150 Q
151 ;
152ERR(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 ;
Note: See TracBrowser for help on using the repository browser.