BMXADO	; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
	;;2.1;BMX;;Jul 26, 2009
	; 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("SS^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(IEN),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
	;