| 1 | BMXADOF1 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
|
|---|
| 2 | ;;4.1000;BMX;;Apr 17, 2011
|
|---|
| 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 | ;
|
|---|
| 8 | BAFM(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
|
|---|
| 13 | PEEL 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 | ;
|
|---|
| 28 | PREP(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
|
|---|
| 36 | SPEC ; 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
|
|---|
| 44 | DSTG ; 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
|
|---|
| 63 | FILE 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 | ;
|
|---|
| 69 | ERR(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 | ;
|
|---|
