BMXRPC9	; IHS/OIT/HMW - RPC CALL FOR EXTENDED BROKER FUNCTIONALITY ;
	;;2.1;BMX;;Jul 26, 2009
	; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS APPLICATION
	;
	;
	;
SONLY(BMXY,BMXVAL)	;EP Schema Only
	;
	I BMXVAL="TRUE" S BMX("SCHEMA ONLY")=1
	E  S BMX("SCHEMA ONLY")=0
	S BMXY=BMX("SCHEMA ONLY")
	;
	Q
	;
TESTRPC(BMXGBL,BMXSQL)	;
	;Test retrieval/update statement
	;
	N BMXI,BMXERR,BMXN,BMXNOD,BMXNAM,BMXSEX,BMXDOB,BMXFAC,BMXTMP,BMXJ
	S X="ETRAP^BMXRPC9",@^%ZOSF("TRAP")
	S BMXGBL="^BMXTMP("_$J_")",BMXERR="",U="^"
	K ^BMXTMP($J)
	S BMXI=0
	;
	;Old column info format:
	;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="I00010BMXIEN"_U_"D00010DOB"_U_"T00030LOCAL_FACLILITY"_U_"T00030NAME"_U_"T00010SEX"_$C(30)
	;
	;New column info format is @@@meta@@@KEYFIELD|FILE#
	;   For each field: ^FILE#|FIELD#|DATATYPE|LENGTH|FIELDNAME|READONLY|KEYFIELD|NULL ALLOWED
	;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="@@@meta@@@"
	;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="BMXIEN|2160010^"
	;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.001|I|10|BMXIEN|TRUE|TRUE^"
	;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.03|D|10|DOB|FALSE|FALSE^"
	;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.04|T|60|LOCAL_FACILITY|FALSE|FALSE^"
	;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.01|T|30|NAME|FALSE|FALSE^"
	;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.02|T|10|SEX|FALSE|FALSE"
	;S BMXI=BMXI+1,^BMXTMP($J,BMXI)=$C(30)
	;
	D SS^BMXADO(.BMXTMP,"","TEST1")
	I $G(BMXTMP)=$C(30) D ERR(99,"SCHEMA GENERATION FAILED") Q
	S BMXJ=0 F  S BMXJ=$O(BMXTMP(BMXJ)) Q:'+BMXJ  D
	. S BMXI=BMXI+1
	. S ^BMXTMP($J,BMXI)=BMXTMP(BMXJ)
	I +$G(BMX("SCHEMA ONLY")) D  Q
	. S BMXI=BMXI+1
	. S ^BMXTMP($J,BMXI)=$C(31)
	. Q
	S BMXN=0
	F  S BMXN=$O(^DIZ(2160010,BMXN)) Q:'+BMXN  D
	. Q:'$D(^DIZ(2160010,BMXN,0))
	. S BMXNOD=^DIZ(2160010,BMXN,0)
	. S BMXNAM=$P(BMXNOD,U)
	. S BMXSEX=$P(BMXNOD,U,2)
	. S BMXDOB=$P(BMXNOD,U,3)
	. S Y=BMXDOB X ^DD("DD") S BMXDOB=Y
	. S BMXFAC=$P(BMXNOD,U,4)
	. S:+BMXFAC BMXFAC=$P($G(^DIC(4,BMXFAC,0)),U)
	. S BMXI=BMXI+1
	. S ^BMXTMP($J,BMXI)=BMXN_U_BMXDOB_U_BMXFAC_U_BMXNAM_U_BMXSEX_$C(30)
	. Q
	S BMXI=BMXI+1
	S ^BMXTMP($J,BMXI)=$C(31)
	Q
	;
ERR(BMXID,BMXERR)	;Error processing
	K ^BMXTMP($J)
	S ^BMXTMP($J,0)="I00030ERRORID^T00030ERRORMSG"_$C(30)
	S ^BMXTMP($J,1)=BMXID_"^"_BMXERR_$C(30)
	S ^BMXTMP($J,2)=$C(31)
	Q
	;
ETRAP	;EP Error trap entry
	D ^%ZTER
	D ERR(99,"BMXRPC9 Error: "_$G(%ZTERROR))
	Q
	;
TEST	N OUT S OUT="" D ADO(.OUT,2160010,"1",(".01|A,A"_$C(30)_".02|M"_$C(30)_".03|1/5/1946"_$C(30)_".04|SAN XAVIER"_$C(31))) W !,OUT
	Q
	;
ADOX(OUT,FILE,IEN,DATA)	;
	;
	D DEBUG^%Serenji("ADOX^BMXRPC9(.OUT,FILE,IEN,DATA)")
	;
	Q
	;
ADO(OUT,FILE,IEN,DATA)	; RPC CALL: OUT = OUTBOUND MESSAGE, FILE = FILEMAN FILE NUMBER, IEN = FILE INTERNAL ENTRY NUMBER, DATA = DATA STRING
	N OREF,CREF,DIC,DIE,DA,DR,X,Y,%,FLD,CNT,FNO,VAL,TFLG,DFLG,TOT,UFLG,XTFLG,GTFLG,GDFLG
	S OUT="",FLD="",GTFLG=0,GDFLG=0
	S IEN=$G(IEN)
	I $E(IEN)="-" S IEN=$E(IEN,2,99),GDFLG=1 ; GLOBAL DELETE FLAG
	I $E(IEN)="+" S IEN=$E(IEN,2,99),GTFLG=1 ; GLOBAL TRANSACTION FLAG, ROLLBACK IF ANY FIELD FAILS TO UPDATE
	I IEN="Add"!(IEN="ADD") S IEN=""
	I '$D(^DIC(+$G(FILE),0,"GL")) S OUT="Update cancelled. Invalid FILE number" Q
	S OREF=^DIC(FILE,0,"GL") I '$L(OREF) S OUT="Update cancelled.  Invalid file definition" Q
	S CREF=$E(OREF,1,$L(OREF)-1) I $E(OREF,$L(OREF))="," S CREF=CREF_")" ; CONVERT OREF TO CREF
	I IEN,'$D(@CREF@(IEN)) S OUT="Update cancelled. Invalid IEN" Q
	I 'GDFLG,IEN,(DATA["-.01|"!(DATA[".01|@")) S GDFLG=1
	I GDFLG,'IEN S OUT="Deletion cancelled. Missing IEN" Q
	I GDFLG D DIK(OREF,IEN) S OUT="Record deleted|"_IEN Q
	S UFLG=$S($G(IEN):"E",1:"A") ; UPDATE FLAG: ADD OR EDIT
	I '$L($G(DATA)) S OUT="Update cancelled.  Missing/invalid data string" Q
	S TOT=$L(DATA,$C(30)) I 'TOT S OUT="Update cancelled.  Missing data string" Q
	F CNT=1:1:TOT S DATA(CNT)=$P(DATA,$C(30),CNT) ; BUILD PRIMARY FIELD ARRAY
	S %=DATA(1) I %=""!(%=$C(31)) S OUT="Update cancelled.  Missing data string" Q
	S %=DATA(CNT) I %[$C(31) S %=$P(%,$C(31),1),DATA(CNT)=% ; STRIP OFF END OF FILE MARKER
	F CNT=1:1:TOT S X=DATA(CNT) I $L(X) D  ; BUILD SECONDARY FIELD ARRAY
	. S TFLG=0,DFLG=0
	. I $E(X)="+" S TFLG=1,X=$E(X,2,999),$P(FLD,U)=1
	. I $E(X)="-" S DFLG=1,X=$E(X,2,999)
	. S FNO=$P(X,"|"),VAL=$P(X,"|",2)
	. I '$D(^DD(FILE,+$G(FNO),0)) S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid field number" Q
	. I DFLG,VAL'="" S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid deletion syntax" Q  ; CANT DELETE IF A VALUE IS SENT
	. I DFLG!(VAL="") S VAL="@" ; SYNC DFLG AND VAL
	. I VAL="@" S DFLG=1 ; SYNC DFLG AND VAL
	. S FLD(FNO)=VAL_U_TFLG_U_DFLG
	. I FNO=.01,TFLG S $P(FLD,U,2)=1 ; 
	. Q
	I $P($G(FLD(.01)),U,3),UFLG="A" S OUT="Record deletion cancelled.  Missing IEN" Q  ; CAN'T DELETE A RECORD WITHOUT A VALID IEN
DELREC	I $P($G(FLD(.01)),U,3) D DIK(OREF,IEN) S OUT="OK" Q  ; DELETE THE RECORD
	I UFLG="A",'$L($P($G(FLD(.01)),U)) S OUT="Record addition cancelled.  Missing .01 field" Q  ; CAN'T ADD A RECORD WITHOUT A VALID .01 FIELD
ADDREC	I UFLG="A" D ADD(OREF) Q  ; ADD A NEW ENTRY TO A FILE
EDITREC	I UFLG="E" D EDIT(OREF,IEN) Q  ; EDIT AN EXISTING RECORD
	Q
	;
DIK(DIK,DA)	; DELETE A RECORD
	D ^DIK
	D ^XBFMK
	Q
	;
ADD(DIC)	; ADD A NEW ENTRY TO A FILE
	N X,Y
	S X=""""_$P($G(FLD(.01)),U)_""""
	S DIC(0)="L"
	D ^DIC
	I Y=-1 S OUT="Unable to add a new record" G AX
	I $O(FLD(.01)) D EDIT(DIC,+Y) Q
	S OUT="OK"_"|"_+Y
AX	D ^XBFMK
	Q
	;
EDIT(DIE,DA)	; EDIT AN EXISTING RECORD
	N DR,RFLG,ERR,FNO,VAL,TFLG,RESULT,MSG,DIERR,DISYS
	S FNO=$O(FLD(.01),-1),DR="" ;HMW Changed to include .01 in DR string
	I UFLG="A" S OUT="New record added|"_DA
	F  S FNO=$O(FLD(FNO)) Q:'FNO  S X=FLD(FNO) I $L(X) D  I $G(RFLG) Q  ; CHECK EA FIELD AND BUILD THE DR STRING AND ERROR STRING
	. S VAL(FNO)=$P(X,U),TFLG=$P(X,U,2) I '$L(VAL(FNO)) Q
	. K ERR,RESULT
	. I VAL(FNO)="@"!(VAL(FNO)="") S RESULT="@"
	. E  D CHK^DIE(FILE,FNO,"",VAL(FNO),.RESULT,"ERR")
	. I RESULT=U D  Q
	.. S MSG=$G(ERR("DIERR",1,"TEXT",1),"Failed FileMan data validation")
	.. I $L(OUT) S OUT=OUT_"~"
	.. I TFLG!GTFLG S RFLG=1,OUT=FNO_"|"_MSG Q
	.. S OUT=OUT_FNO_"|"_MSG
	.. Q
	. S VAL(FNO)=RESULT
	. I $L(DR) S DR=DR_";"
	. S DR=DR_FNO_"////^S X=VAL("_FNO_")" ; BUILD DR STRING
	. Q
	I $G(RFLG) D:UFLG="A" DIK(DIE,DA) S OUT="Record update cancelled"_"|"_OUT G EX ; TRANSACTION ROLLBACK FLAG IS SET, ENTRY DELETED (ADD MODE) OR UPDATE CANCELLED (EDIT MODE)
	L +@CREF@(DA):2 I $T D ^DIE L -@CREF@(DA) G:OUT["valid" EX S OUT="OK" S:UFLG="A" OUT=OUT_"|"_DA G EX ; SUCCESS!!!!
	S OUT="Update cancelled. File locked" ; FILE LOCKED. UNABLE TO UPDATE
	I $L(FLD),UFLG="A" D DIK(DIE,DA) ; ROLLBACK THE NEW RECORD
EX	D ^XBFMK ; CLEANUP
	Q
	;