Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BMXRPC9

BMXRPC9.m

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