BMXADOF1 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
;;4.0;BMX;**4**;JUN 28, 2010;Build 4
; 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,ERR
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
;
;ICD Checking
I (FILE=9000011)!(FILE=9000010.07) D DXCK(FILE,SCHEMA,DATA,.ERR) I $G(ERR)]"" 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
;
DXCK(FILE,SCHEMA,DATA,ERR) ;Special code to check ICDs for PROBLEM and V POV entry
;
NEW PCE,MAX,CKDT,ICD,CINFO
;
S MAX=$L(SCHEMA,U)
;
S (ICD,CKDT,CINFO)=""
F PCE=2:1:MAX D
. NEW FLD,VAL,NODE
. S NODE=$P(SCHEMA,U,PCE)
. S VAL=$P(DATA,U,PCE)
. S FLD=$P(NODE,"|",5)
. ;
. ;If PROBLEM file get DATE ENTERED and DIAGNOSIS
. I FILE="9000011" D
.. I FLD="DIAGNOSIS" S ICD=$TR(VAL,"`")
.. I FLD="DATE ENTERED" S CKDT=VAL
. ;
. ;If V POV file get POV and visit date/time using VISIT
. I FILE="9000010.07" D
.. I FLD="VISIT" S CKDT=$$GET1^DIQ(9000010,$TR(VAL,"`")_",",.01,"I")
.. I FLD="POV" S ICD=$TR(VAL,"`")
;
;If date is blank default to today
S:CKDT="" CKDT=DT
;
;Look in appropriate CODESET
;
;Pre-AICD Install - ICD9
I ICD]"" D
. I $$VERSION^XPDUTL("AICD")<4.0 S CINFO=$$ICDDX^ICDCODE(ICD)
. ;
. ;Post-AICD Install - ICD9 or ICD10
. I $$VERSION^XPDUTL("AICD")>3.51 D
.. NEW CDST
.. I $$IMP^ICDEXA(30)'>CKDT S CDST=30
.. E S CDST=1
.. S CINFO=$$ICDDATA^ICDXCODE(CDST,ICD,CKDT,"I")
. ;
. ;Verify code matches CODESET
. I +CINFO<0 S ERR=$P(CINFO,"^",2)
;
Q
;
ERR(ERR) ;
I '$L($G(ERR)) Q
S ECNT=$G(ECNT)+1
S CNT=CNT+1
S OUT(CNT)=ERR
Q
;
BMXADOF1 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
+1 ;;4.0;BMX;**4**;JUN 28, 2010;Build 4
+2 ; UPDATE FILEMAN WITH AN ADO RECORD SET FROM A WINDOWS/WEB APPLICATION
+3 ;
+4 ;
+5 ; W !!! ZW OUT K OUT Q
DO BAFM(.OUT,$NAME(^TMP("BMX ADO",6)))
+6 ;
BAFM(OUT,CREF) ; EP- RPC: PASS DATA FROM A STD BROKER ADO ARRAY TO FILEMAN AND RETURN THE ACK MSG IN 'OUT' ARRAY
+1 ; REFERENCE MUST EXIST
IF '$LENGTH($GET(CREF))
QUIT
+2 ; DATASET MUST EXIST
IF '$DATA(@CREF)
QUIT
+3 NEW NODE,STG,DATA,SCHEMA,X,ECNT,CNT
+4 SET OUT="DONE"
SET ECNT=0
SET CNT=0
PEEL ; PEEL DATA OFF THE ARRAY AND FILE IT
SET NODE=0
SET STG=""
+1 ; LOOP THRU THE NODES TO BUILD A STRING.
FOR
SET NODE=$ORDER(@CREF@(NODE))
IF 'NODE
QUIT
Begin DoDot:1
+2 SET X=@CREF@(NODE)
IF X=""
QUIT
+3 SET STG=STG_X
+4 ; WHEN YOU HIT $C(30), PROCESS THE CURRENT STRING, AND THEN START A NEW STRING.
IF STG[$CHAR(30)
Begin DoDot:2
+5 ; REMOVE THE EOR CHARACTER $C(30) FROM THE END OF THE STRING
SET STG=$TRANSLATE(STG,$CHAR(30),"")
+6 ; GET SCHEMA STRING. THEN KEEP LOOPING TO GET THE DATA STRINGS
IF STG["@@@meta@@@"
SET SCHEMA=STG
QUIT
+7 ; PREP DATA STRING FOR FILING, AND THEN FILE THE DATA
DO PREP(.OUT,SCHEMA,STG)
+8 QUIT
End DoDot:2
SET STG=""
QUIT
+9 QUIT
End DoDot:1
+10 ; CLEAN UP
KILL @CREF
+11 ; SUMMARY NODE OF THE OUTPUT ARRAY
IF ECNT=0
SET OUT(0)="OK"
QUIT
+12 SET OUT(0)=ECNT_" error(s) detected in this transaction"
+13 QUIT
+14 ;
PREP(OUT,SCHEMA,DATA) ; PREPARE DATA FOR THE ADO FILER
+1 NEW TOP,LEV,C,B,%,DA,DAS,PCE,MAX,S,D,FILE,DSTG,MAND,FLD,VAL,MSG,ERR
+2 SET C=","
SET B="|"
SET DAS=""
+3 SET %=$PIECE(SCHEMA,U,2)
SET TOP=$PIECE(%,B,2)
+4 SET LEV=$LENGTH(TOP)-3
IF LEV=2
SET DAS=+DATA_C
+5 SET SCHEMA=$PIECE(SCHEMA,U,2,999)
+6 SET MAX=$LENGTH(SCHEMA,U)
+7 SET FILE=+SCHEMA
IF '$DATA(^DD(FILE,0))
SET ERR="Update failed. Missing/invalid file number"
DO ERR(ERR)
QUIT
+8 ;
+9 ;ICD Checking
+10 IF (FILE=9000011)!(FILE=9000010.07)
DO DXCK(FILE,SCHEMA,DATA,.ERR)
IF $GET(ERR)]""
DO ERR(ERR)
QUIT
+11 ;
SPEC ; CHECK FOR SPECIAL CASES
+1 IF FILE=9000011
IF SCHEMA'["|.05|"
GOTO DSTG
+2 IF FILE=9000010.07
IF SCHEMA'["|.04|"
GOTO DSTG
+3 IF FILE=9000010.18
IF SCHEMA'["|.04|"
GOTO DSTG
+4 IF FILE=9000013
IF SCHEMA'["|.04|"
GOTO DSTG
+5 IF FILE=9000014
IF SCHEMA'["|.04|"
GOTO DSTG
+6 IF FILE'=9000010.07
IF FILE'=9000011
IF FILE'=9000013
IF FILE'=9000014
IF FILE'=9000010.18
+7 ; GET IEN OF PROVIDER NARRATIVE AND SUBSTITUE THIS VALUE IN THE DATA STG
IF '$TEST
IF '$$NARR^BMXADOF2
QUIT
DSTG ; BUILD THE ADD/UPDATE STRING FOR THE EBCU FILER
+1 SET DA=+DATA
SET DAS=DAS_DA
SET DSTG=""
+2 FOR PCE=2:1:MAX
Begin DoDot:1
+3 SET S=$PIECE(SCHEMA,U,PCE)
SET VAL=$PIECE(DATA,U,PCE)
+4 ; READ ONLY
IF $PIECE(S,B,6)="TRUE"
QUIT
+5 ; INVALID SCHEMA PIECE
SET FLD=$PIECE(S,B,2)
IF 'FLD
QUIT
+6 ; IEN NOT DATA
IF $EXTRACT(FLD,1,3)=".00"
QUIT
+7 ; DON'T FILE THE IDENTIFIERS
IF FLD["ID"
QUIT
+8 ; WAIT FOR THE LOOKUP VALUE, BYPASS CURRENT FIELD
IF SCHEMA[(B_FLD_"IEN")
IF FLD'["IEN"
IF $LENGTH(VAL)
QUIT
+9 SET FLD=+FLD
+10 ; MANDATORY FIELD
IF $PIECE(S,B,8)'="TRUE"
SET FLD="+"_FLD
+11 ; DELETE THE VALUE
IF '$TEST
IF VAL=""
SET FLD="-"_FLD
+12 ; MAKE SURE THAT THE .01 FIELD IS FIRST!
IF FLD?.1E1".01"
Begin DoDot:2
+13 ; APPEND .01 FIELD TO THE FRONT OF AN EXISTING UPDATE STRING
IF $LENGTH(DSTG)
SET DSTG=FLD_B_VAL_$CHAR(30)_DSTG
QUIT
+14 ; START A NEW UPDATE STRING WITH THE .01 FIELD
SET DSTG=FLD_B_VAL
+15 QUIT
End DoDot:2
QUIT
+16 ; $C(30) IS THE "COLUMN" DELIMITER FOR DATA TO BE ENETERED IN THE TABLE
IF $LENGTH(DSTG)
SET DSTG=DSTG_$CHAR(30)
+17 ; "|" IS THE DATA ELEMENT DELIMITER, SEPARATING FIELD NAME AND FIELD VALUE
SET DSTG=DSTG_FLD_B_VAL
+18 QUIT
End DoDot:1
FILE ; THE DATA STRING IS PREPARED. NOW SEND IT TO THE EBCU FILER.
DO FILE^BMXADOF(.MSG,FILE,DAS,DSTG)
+1 IF $EXTRACT(MSG,1,2)'="OK"
SET ECNT=ECNT+1
+2 SET CNT=CNT+1
SET OUT(CNT)=MSG
+3 ; S DSTG=$TR(DSTG,$C(30),"}") W !,DSTG ; TEMP OUTPUT - REMOVE THIS LINE AFTER TESTING COMPLETED!
+4 QUIT
+5 ;
DXCK(FILE,SCHEMA,DATA,ERR) ;Special code to check ICDs for PROBLEM and V POV entry
+1 ;
+2 NEW PCE,MAX,CKDT,ICD,CINFO
+3 ;
+4 SET MAX=$LENGTH(SCHEMA,U)
+5 ;
+6 SET (ICD,CKDT,CINFO)=""
+7 FOR PCE=2:1:MAX
Begin DoDot:1
+8 NEW FLD,VAL,NODE
+9 SET NODE=$PIECE(SCHEMA,U,PCE)
+10 SET VAL=$PIECE(DATA,U,PCE)
+11 SET FLD=$PIECE(NODE,"|",5)
+12 ;
+13 ;If PROBLEM file get DATE ENTERED and DIAGNOSIS
+14 IF FILE="9000011"
Begin DoDot:2
+15 IF FLD="DIAGNOSIS"
SET ICD=$TRANSLATE(VAL,"`")
+16 IF FLD="DATE ENTERED"
SET CKDT=VAL
End DoDot:2
+17 ;
+18 ;If V POV file get POV and visit date/time using VISIT
+19 IF FILE="9000010.07"
Begin DoDot:2
+20 IF FLD="VISIT"
SET CKDT=$$GET1^DIQ(9000010,$TRANSLATE(VAL,"`")_",",.01,"I")
+21 IF FLD="POV"
SET ICD=$TRANSLATE(VAL,"`")
End DoDot:2
End DoDot:1
+22 ;
+23 ;If date is blank default to today
+24 IF CKDT=""
SET CKDT=DT
+25 ;
+26 ;Look in appropriate CODESET
+27 ;
+28 ;Pre-AICD Install - ICD9
+29 IF ICD]""
Begin DoDot:1
+30 IF $$VERSION^XPDUTL("AICD")<4.0
SET CINFO=$$ICDDX^ICDCODE(ICD)
+31 ;
+32 ;Post-AICD Install - ICD9 or ICD10
+33 IF $$VERSION^XPDUTL("AICD")>3.51
Begin DoDot:2
+34 NEW CDST
+35 IF $$IMP^ICDEXA(30)'>CKDT
SET CDST=30
+36 IF '$TEST
SET CDST=1
+37 SET CINFO=$$ICDDATA^ICDXCODE(CDST,ICD,CKDT,"I")
End DoDot:2
+38 ;
+39 ;Verify code matches CODESET
+40 IF +CINFO<0
SET ERR=$PIECE(CINFO,"^",2)
End DoDot:1
+41 ;
+42 QUIT
+43 ;
ERR(ERR) ;
+1 IF '$LENGTH($GET(ERR))
QUIT
+2 SET ECNT=$GET(ECNT)+1
+3 SET CNT=CNT+1
+4 SET OUT(CNT)=ERR
+5 QUIT
+6 ;
