source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOF1.m@ 1243

BMXADOF1        ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
        ;;2.31;BMX;;Jul 25, 2011
        ; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS/WEB APPLICATION
        ; 
        ; 
        D BAFM(.OUT,$NA(^TMP("BMX ADO",6))) ; W !!! ZW OUT K OUT Q
        ; 
BAFM(OUT,CREF)  ; EP- RPC: PASS DATA FROM A STD BROKER ADO ARRAY TO FILEMAN AND RETURN THE ACK MSG IN 'OUT' ARRAY
        I '$L($G(CREF)) Q  ; REFERENCE MUST EXIST
        I '$D(@CREF) Q  ; DATASET MUST EXIST
        N NODE,STG,DATA,SCHEMA,X,ECNT,CNT
        S OUT="DONE",ECNT=0,CNT=0
PEEL    S NODE=0,STG="" ; PEEL DATA OFF THE ARRAY AND FILE IT
        F  S NODE=$O(@CREF@(NODE)) Q:'NODE  D  ; LOOP THRU THE NODES TO BUILD A STRING.
        . S X=@CREF@(NODE) I X="" Q
        . S STG=STG_X
        . I STG[$C(30) D  S STG="" Q  ;  WHEN YOU HIT $C(30), PROCESS THE CURRENT STRING, AND THEN START A NEW STRING.
        .. S STG=$TR(STG,$C(30),"") ; REMOVE THE EOR CHARACTER $C(30) FROM THE END OF THE STRING
        .. I STG["@@@meta@@@" S SCHEMA=STG Q  ; GET SCHEMA STRING. THEN KEEP LOOPING TO GET THE DATA STRINGS
        .. D PREP(.OUT,SCHEMA,STG) ; PREP DATA STRING FOR FILING, AND THEN FILE THE DATA
        .. Q
        . Q
        K @CREF ; CLEAN UP
        I ECNT=0 S OUT(0)="OK" Q  ; SUMMARY NODE OF THE OUTPUT ARRAY
        S OUT(0)=ECNT_" error(s) detected in this transaction"
        Q
        ; 
PREP(OUT,SCHEMA,DATA)   ; PREPARE DATA FOR THE ADO FILER
        N TOP,LEV,C,B,%,DA,DAS,PCE,MAX,S,D,FILE,DSTG,MAND,FLD,VAL,MSG
        S C=",",B="|",DAS=""
        S %=$P(SCHEMA,U,2) S TOP=$P(%,B,2)
        S LEV=$L(TOP)-3 I LEV=2 S DAS=+DATA_C
        S SCHEMA=$P(SCHEMA,U,2,999)
        S MAX=$L(SCHEMA,U)
        S FILE=+SCHEMA I '$D(^DD(FILE,0)) S ERR="Update failed.  Missing/invalid file number" D ERR(ERR) Q
SPEC    ; CHECK FOR SPECIAL CASES
        I FILE=9000011,SCHEMA'["|.05|" G DSTG
        I FILE=9000010.07,SCHEMA'["|.04|" G DSTG
        I FILE=9000010.18,SCHEMA'["|.04|" G DSTG
        I FILE=9000013,SCHEMA'["|.04|" G DSTG
        I FILE=9000014,SCHEMA'["|.04|" G DSTG
        I FILE'=9000010.07,FILE'=9000011,FILE'=9000013,FILE'=9000014,FILE'=9000010.18
        E  I '$$NARR^BMXADOF2 Q  ; GET IEN OF PROVIDER NARRATIVE AND SUBSTITUE THIS VALUE IN THE DATA STG
DSTG    ; BUILD THE ADD/UPDATE STRING FOR THE EBCU FILER
        S DA=+DATA,DAS=DAS_DA,DSTG=""
        F PCE=2:1:MAX D
        . S S=$P(SCHEMA,U,PCE),VAL=$P(DATA,U,PCE)
        . I $P(S,B,6)="TRUE" Q  ; READ ONLY
        . S FLD=$P(S,B,2) I 'FLD Q  ; INVALID SCHEMA PIECE
        . I $E(FLD,1,3)=".00" Q  ; IEN NOT DATA
        . I FLD["ID" Q  ; DON'T FILE THE IDENTIFIERS
        . I SCHEMA[(B_FLD_"IEN"),FLD'["IEN",$L(VAL) Q  ; WAIT FOR THE LOOKUP VALUE, BYPASS CURRENT FIELD
        . S FLD=+FLD
        . I $P(S,B,8)'="TRUE" S FLD="+"_FLD ; MANDATORY FIELD
        . E  I VAL="" S FLD="-"_FLD ; DELETE THE VALUE
        . I FLD?.1E1".01" D  Q  ; MAKE SURE THAT THE .01 FIELD IS FIRST!
        .. I $L(DSTG) S DSTG=FLD_B_VAL_$C(30)_DSTG Q  ; APPEND .01 FIELD TO THE FRONT OF AN EXISTING UPDATE STRING
        .. S DSTG=FLD_B_VAL ; START A NEW UPDATE STRING WITH THE .01 FIELD
        .. Q
        . I $L(DSTG) S DSTG=DSTG_$C(30) ; $C(30) IS THE "COLUMN" DELIMITER FOR DATA TO BE ENETERED IN THE TABLE
        . S DSTG=DSTG_FLD_B_VAL ; "|" IS THE DATA ELEMENT DELIMITER, SEPARATING FIELD NAME AND FIELD VALUE
        . Q
FILE    D FILE^BMXADOF(.MSG,FILE,DAS,DSTG) ; THE DATA STRING IS PREPARED. NOW SEND IT TO THE EBCU FILER.
        I $E(MSG,1,2)'="OK" S ECNT=ECNT+1
        S CNT=CNT+1 S OUT(CNT)=MSG
        ; S DSTG=$TR(DSTG,$C(30),"}") W !,DSTG ; TEMP OUTPUT - REMOVE THIS LINE AFTER TESTING COMPLETED!
        Q
        ; 
ERR(ERR)        ;
        I '$L($G(ERR)) Q
        S ECNT=$G(ECNT)+1
        S CNT=CNT+1
        S OUT(CNT)=ERR
        Q
        ;