source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOF1.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: 3.3 KB
Line 
1BMXADOF1 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
2 ;;2.1;BMX;;Jul 26, 2009
3 ; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS/WEB APPLICATION
4 ;
5 ;
6 D BAFM(.OUT,$NA(^TMP("BMX ADO",6))) ; W !!! ZW OUT K OUT Q
7 ;
8BAFM(OUT,CREF) ; EP- RPC: PASS DATA FROM A STD BROKER ADO ARRAY TO FILEMAN AND RETURN THE ACK MSG IN 'OUT' ARRAY
9 I '$L($G(CREF)) Q ; REFERENCE MUST EXIST
10 I '$D(@CREF) Q ; DATASET MUST EXIST
11 N NODE,STG,DATA,SCHEMA,X,ECNT,CNT
12 S OUT="DONE",ECNT=0,CNT=0
13PEEL S NODE=0,STG="" ; PEEL DATA OFF THE ARRAY AND FILE IT
14 F S NODE=$O(@CREF@(NODE)) Q:'NODE D ; LOOP THRU THE NODES TO BUILD A STRING.
15 . S X=@CREF@(NODE) I X="" Q
16 . S STG=STG_X
17 . I STG[$C(30) D S STG="" Q ; WHEN YOU HIT $C(30), PROCESS THE CURRENT STRING, AND THEN START A NEW STRING.
18 .. S STG=$TR(STG,$C(30),"") ; REMOVE THE EOR CHARACTER $C(30) FROM THE END OF THE STRING
19 .. I STG["@@@meta@@@" S SCHEMA=STG Q ; GET SCHEMA STRING. THEN KEEP LOOPING TO GET THE DATA STRINGS
20 .. D PREP(.OUT,SCHEMA,STG) ; PREP DATA STRING FOR FILING, AND THEN FILE THE DATA
21 .. Q
22 . Q
23 K @CREF ; CLEAN UP
24 I ECNT=0 S OUT(0)="OK" Q ; SUMMARY NODE OF THE OUTPUT ARRAY
25 S OUT(0)=ECNT_" error(s) detected in this transaction"
26 Q
27 ;
28PREP(OUT,SCHEMA,DATA) ; PREPARE DATA FOR THE ADO FILER
29 N TOP,LEV,C,B,%,DA,DAS,PCE,MAX,S,D,FILE,DSTG,MAND,FLD,VAL,MSG
30 S C=",",B="|",DAS=""
31 S %=$P(SCHEMA,U,2) S TOP=$P(%,B,2)
32 S LEV=$L(TOP)-3 I LEV=2 S DAS=+DATA_C
33 S SCHEMA=$P(SCHEMA,U,2,999)
34 S MAX=$L(SCHEMA,U)
35 S FILE=+SCHEMA I '$D(^DD(FILE,0)) S ERR="Update failed. Missing/invalid file number" D ERR(ERR) Q
36SPEC ; CHECK FOR SPECIAL CASES
37 I FILE=9000011,SCHEMA'["|.05|" G DSTG
38 I FILE=9000010.07,SCHEMA'["|.04|" G DSTG
39 I FILE=9000010.18,SCHEMA'["|.04|" G DSTG
40 I FILE=9000013,SCHEMA'["|.04|" G DSTG
41 I FILE=9000014,SCHEMA'["|.04|" G DSTG
42 I FILE'=9000010.07,FILE'=9000011,FILE'=9000013,FILE'=9000014,FILE'=9000010.18
43 E I '$$NARR^BMXADOF2 Q ; GET IEN OF PROVIDER NARRATIVE AND SUBSTITUE THIS VALUE IN THE DATA STG
44DSTG ; BUILD THE ADD/UPDATE STRING FOR THE EBCU FILER
45 S DA=+DATA,DAS=DAS_DA,DSTG=""
46 F PCE=2:1:MAX D
47 . S S=$P(SCHEMA,U,PCE),VAL=$P(DATA,U,PCE)
48 . I $P(S,B,6)="TRUE" Q ; READ ONLY
49 . S FLD=$P(S,B,2) I 'FLD Q ; INVALID SCHEMA PIECE
50 . I $E(FLD,1,3)=".00" Q ; IEN NOT DATA
51 . I FLD["ID" Q ; DON'T FILE THE IDENTIFIERS
52 . I SCHEMA[(B_FLD_"IEN"),FLD'["IEN",$L(VAL) Q ; WAIT FOR THE LOOKUP VALUE, BYPASS CURRENT FIELD
53 . S FLD=+FLD
54 . I $P(S,B,8)'="TRUE" S FLD="+"_FLD ; MANDATORY FIELD
55 . E I VAL="" S FLD="-"_FLD ; DELETE THE VALUE
56 . I FLD?.1E1".01" D Q ; MAKE SURE THAT THE .01 FIELD IS FIRST!
57 .. I $L(DSTG) S DSTG=FLD_B_VAL_$C(30)_DSTG Q ; APPEND .01 FIELD TO THE FRONT OF AN EXISTING UPDATE STRING
58 .. S DSTG=FLD_B_VAL ; START A NEW UPDATE STRING WITH THE .01 FIELD
59 .. Q
60 . I $L(DSTG) S DSTG=DSTG_$C(30) ; $C(30) IS THE "COLUMN" DELIMITER FOR DATA TO BE ENETERED IN THE TABLE
61 . S DSTG=DSTG_FLD_B_VAL ; "|" IS THE DATA ELEMENT DELIMITER, SEPARATING FIELD NAME AND FIELD VALUE
62 . Q
63FILE D FILE^BMXADOF(.MSG,FILE,DAS,DSTG) ; THE DATA STRING IS PREPARED. NOW SEND IT TO THE EBCU FILER.
64 I $E(MSG,1,2)'="OK" S ECNT=ECNT+1
65 S CNT=CNT+1 S OUT(CNT)=MSG
66 ; S DSTG=$TR(DSTG,$C(30),"}") W !,DSTG ; TEMP OUTPUT - REMOVE THIS LINE AFTER TESTING COMPLETED!
67 Q
68 ;
69ERR(ERR) ;
70 I '$L($G(ERR)) Q
71 S ECNT=$G(ECNT)+1
72 S CNT=CNT+1
73 S OUT(CNT)=ERR
74 Q
75 ;
Note: See TracBrowser for help on using the repository browser.