Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BMXADOF1

BMXADOF1.m

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