BMXADOF1	; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
	;;2.1;BMX;;Jul 26, 2009
	; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS/WEB APPLICATION
	; 
	; 
	D BAFM(.OUT,$NA(^TMP("BMX ADO",6))) ; W !!! ZW OUT K OUT Q
	; 
BAFM(OUT,CREF)	; EP- RPC: PASS DATA FROM A STD BROKER ADO ARRAY TO FILEMAN AND RETURN THE ACK MSG IN 'OUT' ARRAY
	I '$L($G(CREF)) Q  ; REFERENCE MUST EXIST
	I '$D(@CREF) Q  ; DATASET MUST EXIST
	N NODE,STG,DATA,SCHEMA,X,ECNT,CNT
	S OUT="DONE",ECNT=0,CNT=0
PEEL	S NODE=0,STG="" ; PEEL DATA OFF THE ARRAY AND FILE IT
	F  S NODE=$O(@CREF@(NODE)) Q:'NODE  D  ; LOOP THRU THE NODES TO BUILD A STRING.
	. S X=@CREF@(NODE) I X="" Q
	. S STG=STG_X
	. I STG[$C(30) D  S STG="" Q  ;  WHEN YOU HIT $C(30), PROCESS THE CURRENT STRING, AND THEN START A NEW STRING.
	.. S STG=$TR(STG,$C(30),"") ; REMOVE THE EOR CHARACTER $C(30) FROM THE END OF THE STRING
	.. I STG["@@@meta@@@" S SCHEMA=STG Q  ; GET SCHEMA STRING. THEN KEEP LOOPING TO GET THE DATA STRINGS
	.. D PREP(.OUT,SCHEMA,STG) ; PREP DATA STRING FOR FILING, AND THEN FILE THE DATA
	.. Q
	. Q
	K @CREF ; CLEAN UP
	I ECNT=0 S OUT(0)="OK" Q  ; SUMMARY NODE OF THE OUTPUT ARRAY
	S OUT(0)=ECNT_" error(s) detected in this transaction"
	Q
	; 
PREP(OUT,SCHEMA,DATA)	; PREPARE DATA FOR THE ADO FILER
	N TOP,LEV,C,B,%,DA,DAS,PCE,MAX,S,D,FILE,DSTG,MAND,FLD,VAL,MSG
	S C=",",B="|",DAS=""
	S %=$P(SCHEMA,U,2) S TOP=$P(%,B,2)
	S LEV=$L(TOP)-3 I LEV=2 S DAS=+DATA_C
	S SCHEMA=$P(SCHEMA,U,2,999)
	S MAX=$L(SCHEMA,U)
	S FILE=+SCHEMA I '$D(^DD(FILE,0)) S ERR="Update failed.  Missing/invalid file number" D ERR(ERR) Q
SPEC	; CHECK FOR SPECIAL CASES
	I FILE=9000011,SCHEMA'["|.05|" G DSTG
	I FILE=9000010.07,SCHEMA'["|.04|" G DSTG
	I FILE=9000010.18,SCHEMA'["|.04|" G DSTG
	I FILE=9000013,SCHEMA'["|.04|" G DSTG
	I FILE=9000014,SCHEMA'["|.04|" G DSTG
	I FILE'=9000010.07,FILE'=9000011,FILE'=9000013,FILE'=9000014,FILE'=9000010.18
	E  I '$$NARR^BMXADOF2 Q  ; GET IEN OF PROVIDER NARRATIVE AND SUBSTITUE THIS VALUE IN THE DATA STG
DSTG	; BUILD THE ADD/UPDATE STRING FOR THE EBCU FILER
	S DA=+DATA,DAS=DAS_DA,DSTG=""
	F PCE=2:1:MAX D
	. S S=$P(SCHEMA,U,PCE),VAL=$P(DATA,U,PCE)
	. I $P(S,B,6)="TRUE" Q  ; READ ONLY
	. S FLD=$P(S,B,2) I 'FLD Q  ; INVALID SCHEMA PIECE
	. I $E(FLD,1,3)=".00" Q  ; IEN NOT DATA
	. I FLD["ID" Q  ; DON'T FILE THE IDENTIFIERS
	. I SCHEMA[(B_FLD_"IEN"),FLD'["IEN",$L(VAL) Q  ; WAIT FOR THE LOOKUP VALUE, BYPASS CURRENT FIELD
	. S FLD=+FLD
	. I $P(S,B,8)'="TRUE" S FLD="+"_FLD ; MANDATORY FIELD
	. E  I VAL="" S FLD="-"_FLD ; DELETE THE VALUE
	. I FLD?.1E1".01" D  Q  ; MAKE SURE THAT THE .01 FIELD IS FIRST!
	.. I $L(DSTG) S DSTG=FLD_B_VAL_$C(30)_DSTG Q  ; APPEND .01 FIELD TO THE FRONT OF AN EXISTING UPDATE STRING
	.. S DSTG=FLD_B_VAL ; START A NEW UPDATE STRING WITH THE .01 FIELD
	.. Q
	. I $L(DSTG) S DSTG=DSTG_$C(30) ; $C(30) IS THE "COLUMN" DELIMITER FOR DATA TO BE ENETERED IN THE TABLE
	. S DSTG=DSTG_FLD_B_VAL ; "|" IS THE DATA ELEMENT DELIMITER, SEPARATING FIELD NAME AND FIELD VALUE
	. Q
FILE	D FILE^BMXADOF(.MSG,FILE,DAS,DSTG) ; THE DATA STRING IS PREPARED. NOW SEND IT TO THE EBCU FILER.
	I $E(MSG,1,2)'="OK" S ECNT=ECNT+1
	S CNT=CNT+1 S OUT(CNT)=MSG
	; S DSTG=$TR(DSTG,$C(30),"}") W !,DSTG ; TEMP OUTPUT - REMOVE THIS LINE AFTER TESTING COMPLETED!
	Q
	; 
ERR(ERR)	;
	I '$L($G(ERR)) Q
	S ECNT=$G(ECNT)+1
	S CNT=CNT+1
	S OUT(CNT)=ERR
	Q
	;