source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/BMX41000/routines/BMXRPC9.m@ 1396

Last change on this file since 1396 was 1147, checked in by Sam Habiel, 14 years ago

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