source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC9.m@ 794

Last change on this file since 794 was 645, checked in by Sam Habiel, 15 years ago

Initial Import of BMX.net code
File size: 6.4 KB
RevLine 
[645]1BMXRPC9 ; IHS/OIT/HMW - RPC CALL FOR EXTENDED BROKER FUNCTIONALITY ;
2 ;;2.1;BMX;;Jul 26, 2009
3 ; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS APPLICATION
4 ;
5 ;
6 ;
7SONLY(BMXY,BMXVAL) ;EP Schema Only
8 ;
9 I BMXVAL="TRUE" S BMX("SCHEMA ONLY")=1
10 E S BMX("SCHEMA ONLY")=0
11 S BMXY=BMX("SCHEMA ONLY")
12 ;
13 Q
14 ;
15TESTRPC(BMXGBL,BMXSQL) ;
16 ;Test retrieval/update statement
17 ;
18 N BMXI,BMXERR,BMXN,BMXNOD,BMXNAM,BMXSEX,BMXDOB,BMXFAC,BMXTMP,BMXJ
19 S X="ETRAP^BMXRPC9",@^%ZOSF("TRAP")
20 S BMXGBL="^BMXTMP("_$J_")",BMXERR="",U="^"
21 K ^BMXTMP($J)
22 S BMXI=0
23 ;
24 ;Old column info format:
25 ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="I00010BMXIEN"_U_"D00010DOB"_U_"T00030LOCAL_FACLILITY"_U_"T00030NAME"_U_"T00010SEX"_$C(30)
26 ;
27 ;New column info format is @@@meta@@@KEYFIELD|FILE#
28 ; For each field: ^FILE#|FIELD#|DATATYPE|LENGTH|FIELDNAME|READONLY|KEYFIELD|NULL ALLOWED
29 ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="@@@meta@@@"
30 ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="BMXIEN|2160010^"
31 ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.001|I|10|BMXIEN|TRUE|TRUE^"
32 ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.03|D|10|DOB|FALSE|FALSE^"
33 ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.04|T|60|LOCAL_FACILITY|FALSE|FALSE^"
34 ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.01|T|30|NAME|FALSE|FALSE^"
35 ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)="2160010|.02|T|10|SEX|FALSE|FALSE"
36 ;S BMXI=BMXI+1,^BMXTMP($J,BMXI)=$C(30)
37 ;
38 D SS^BMXADO(.BMXTMP,"","TEST1")
39 I $G(BMXTMP)=$C(30) D ERR(99,"SCHEMA GENERATION FAILED") Q
40 S BMXJ=0 F S BMXJ=$O(BMXTMP(BMXJ)) Q:'+BMXJ D
41 . S BMXI=BMXI+1
42 . S ^BMXTMP($J,BMXI)=BMXTMP(BMXJ)
43 I +$G(BMX("SCHEMA ONLY")) D Q
44 . S BMXI=BMXI+1
45 . S ^BMXTMP($J,BMXI)=$C(31)
46 . Q
47 S BMXN=0
48 F S BMXN=$O(^DIZ(2160010,BMXN)) Q:'+BMXN D
49 . Q:'$D(^DIZ(2160010,BMXN,0))
50 . S BMXNOD=^DIZ(2160010,BMXN,0)
51 . S BMXNAM=$P(BMXNOD,U)
52 . S BMXSEX=$P(BMXNOD,U,2)
53 . S BMXDOB=$P(BMXNOD,U,3)
54 . S Y=BMXDOB X ^DD("DD") S BMXDOB=Y
55 . S BMXFAC=$P(BMXNOD,U,4)
56 . S:+BMXFAC BMXFAC=$P($G(^DIC(4,BMXFAC,0)),U)
57 . S BMXI=BMXI+1
58 . S ^BMXTMP($J,BMXI)=BMXN_U_BMXDOB_U_BMXFAC_U_BMXNAM_U_BMXSEX_$C(30)
59 . Q
60 S BMXI=BMXI+1
61 S ^BMXTMP($J,BMXI)=$C(31)
62 Q
63 ;
64ERR(BMXID,BMXERR) ;Error processing
65 K ^BMXTMP($J)
66 S ^BMXTMP($J,0)="I00030ERRORID^T00030ERRORMSG"_$C(30)
67 S ^BMXTMP($J,1)=BMXID_"^"_BMXERR_$C(30)
68 S ^BMXTMP($J,2)=$C(31)
69 Q
70 ;
71ETRAP ;EP Error trap entry
72 D ^%ZTER
73 D ERR(99,"BMXRPC9 Error: "_$G(%ZTERROR))
74 Q
75 ;
76TEST 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
77 Q
78 ;
79ADOX(OUT,FILE,IEN,DATA) ;
80 ;
81 D DEBUG^%Serenji("ADOX^BMXRPC9(.OUT,FILE,IEN,DATA)")
82 ;
83 Q
84 ;
85ADO(OUT,FILE,IEN,DATA) ; RPC CALL: OUT = OUTBOUND MESSAGE, FILE = FILEMAN FILE NUMBER, IEN = FILE INTERNAL ENTRY NUMBER, DATA = DATA STRING
86 N OREF,CREF,DIC,DIE,DA,DR,X,Y,%,FLD,CNT,FNO,VAL,TFLG,DFLG,TOT,UFLG,XTFLG,GTFLG,GDFLG
87 S OUT="",FLD="",GTFLG=0,GDFLG=0
88 S IEN=$G(IEN)
89 I $E(IEN)="-" S IEN=$E(IEN,2,99),GDFLG=1 ; GLOBAL DELETE FLAG
90 I $E(IEN)="+" S IEN=$E(IEN,2,99),GTFLG=1 ; GLOBAL TRANSACTION FLAG, ROLLBACK IF ANY FIELD FAILS TO UPDATE
91 I IEN="Add"!(IEN="ADD") S IEN=""
92 I '$D(^DIC(+$G(FILE),0,"GL")) S OUT="Update cancelled. Invalid FILE number" Q
93 S OREF=^DIC(FILE,0,"GL") I '$L(OREF) S OUT="Update cancelled. Invalid file definition" Q
94 S CREF=$E(OREF,1,$L(OREF)-1) I $E(OREF,$L(OREF))="," S CREF=CREF_")" ; CONVERT OREF TO CREF
95 I IEN,'$D(@CREF@(IEN)) S OUT="Update cancelled. Invalid IEN" Q
96 I 'GDFLG,IEN,(DATA["-.01|"!(DATA[".01|@")) S GDFLG=1
97 I GDFLG,'IEN S OUT="Deletion cancelled. Missing IEN" Q
98 I GDFLG D DIK(OREF,IEN) S OUT="Record deleted|"_IEN Q
99 S UFLG=$S($G(IEN):"E",1:"A") ; UPDATE FLAG: ADD OR EDIT
100 I '$L($G(DATA)) S OUT="Update cancelled. Missing/invalid data string" Q
101 S TOT=$L(DATA,$C(30)) I 'TOT S OUT="Update cancelled. Missing data string" Q
102 F CNT=1:1:TOT S DATA(CNT)=$P(DATA,$C(30),CNT) ; BUILD PRIMARY FIELD ARRAY
103 S %=DATA(1) I %=""!(%=$C(31)) S OUT="Update cancelled. Missing data string" Q
104 S %=DATA(CNT) I %[$C(31) S %=$P(%,$C(31),1),DATA(CNT)=% ; STRIP OFF END OF FILE MARKER
105 F CNT=1:1:TOT S X=DATA(CNT) I $L(X) D ; BUILD SECONDARY FIELD ARRAY
106 . S TFLG=0,DFLG=0
107 . I $E(X)="+" S TFLG=1,X=$E(X,2,999),$P(FLD,U)=1
108 . I $E(X)="-" S DFLG=1,X=$E(X,2,999)
109 . S FNO=$P(X,"|"),VAL=$P(X,"|",2)
110 . I '$D(^DD(FILE,+$G(FNO),0)) S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid field number" Q
111 . I DFLG,VAL'="" S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid deletion syntax" Q ; CANT DELETE IF A VALUE IS SENT
112 . I DFLG!(VAL="") S VAL="@" ; SYNC DFLG AND VAL
113 . I VAL="@" S DFLG=1 ; SYNC DFLG AND VAL
114 . S FLD(FNO)=VAL_U_TFLG_U_DFLG
115 . I FNO=.01,TFLG S $P(FLD,U,2)=1 ;
116 . Q
117 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
118DELREC I $P($G(FLD(.01)),U,3) D DIK(OREF,IEN) S OUT="OK" Q ; DELETE THE RECORD
119 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
120ADDREC I UFLG="A" D ADD(OREF) Q ; ADD A NEW ENTRY TO A FILE
121EDITREC I UFLG="E" D EDIT(OREF,IEN) Q ; EDIT AN EXISTING RECORD
122 Q
123 ;
124DIK(DIK,DA) ; DELETE A RECORD
125 D ^DIK
126 D ^XBFMK
127 Q
128 ;
129ADD(DIC) ; ADD A NEW ENTRY TO A FILE
130 N X,Y
131 S X=""""_$P($G(FLD(.01)),U)_""""
132 S DIC(0)="L"
133 D ^DIC
134 I Y=-1 S OUT="Unable to add a new record" G AX
135 I $O(FLD(.01)) D EDIT(DIC,+Y) Q
136 S OUT="OK"_"|"_+Y
137AX D ^XBFMK
138 Q
139 ;
140EDIT(DIE,DA) ; EDIT AN EXISTING RECORD
141 N DR,RFLG,ERR,FNO,VAL,TFLG,RESULT,MSG,DIERR,DISYS
142 S FNO=$O(FLD(.01),-1),DR="" ;HMW Changed to include .01 in DR string
143 I UFLG="A" S OUT="New record added|"_DA
144 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
145 . S VAL(FNO)=$P(X,U),TFLG=$P(X,U,2) I '$L(VAL(FNO)) Q
146 . K ERR,RESULT
147 . I VAL(FNO)="@"!(VAL(FNO)="") S RESULT="@"
148 . E D CHK^DIE(FILE,FNO,"",VAL(FNO),.RESULT,"ERR")
149 . I RESULT=U D Q
150 .. S MSG=$G(ERR("DIERR",1,"TEXT",1),"Failed FileMan data validation")
151 .. I $L(OUT) S OUT=OUT_"~"
152 .. I TFLG!GTFLG S RFLG=1,OUT=FNO_"|"_MSG Q
153 .. S OUT=OUT_FNO_"|"_MSG
154 .. Q
155 . S VAL(FNO)=RESULT
156 . I $L(DR) S DR=DR_";"
157 . S DR=DR_FNO_"////^S X=VAL("_FNO_")" ; BUILD DR STRING
158 . Q
159 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)
160 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!!!!
161 S OUT="Update cancelled. File locked" ; FILE LOCKED. UNABLE TO UPDATE
162 I $L(FLD),UFLG="A" D DIK(DIE,DA) ; ROLLBACK THE NEW RECORD
163EX D ^XBFMK ; CLEANUP
164 Q
165 ;
Note: See TracBrowser for help on using the repository browser.