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

BAREDP02.m

Go to the documentation of this file. 
  1. BAREDP02 ; IHS/SD/LSL - PARSE SEGMENTS INTO ELEMENTS AND CONVERT ; 11 Jul 2011  2:50 PM
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,5,20,21**;OCT 26,2005
  1.  ;
  1.  ; IHS/SD/LSL - 08/19/02 - V1.7 Patch 4 - HIPAA
  1.  ;     Modified EN to use EDI Standard Data Types File if data types
  1.  ;     are not specified in A/R Transport File
  1.  ;
  1.  ; IHS/SD/LSL - 02/10/04 - V1.7 Patch 5  - Remark Codes
  1.  ;       Add HRMKCD line tag to look up Remark Codes in
  1.  ;       A/R REMARK CODE File
  1.  ;       Add LQCD line tag for NCPDP reject/payment codes and
  1.  ;       remark codes.
  1.  ;
  1.  ; IHS/SD/LSL - 2/9/04 - V1.7 Patch 5 - IM12514
  1.  ;      Denial codes for proprietary ERA not working correctly
  1.  ;
  1.  ; IHS/SD/LSL - 06/23/04 V1.8 Patch 1 - IM13518
  1.  ;      "+" standard code before lookup table in case leading zero sent
  1.  ;
  1.  ; IHS/SD/SDR - bar*1.8*20 - ERA REQ1 - Added CHKS tag to populate Check/EFT multiple
  1.  ;      
  1.  ; *******************************************************************
  1.  ;;
  1. EN(TRDA,IMPDA)     ;EP
  1.  S TABID=$$GET1^DIQ(90056.01,TRDA,.03)      ; Table data type code
  1.  ;
  1.  ; gather data types & conversions
  1.  K DAT
  1.  D ENPM^XBDIQ1(90056.0103,"TRDA,0",".01;.02;.03","DAT(")
  1.  I '$D(DAT) D
  1.  . S BARI=0
  1.  . F  S BARI=$O(^BAREDT(BARI)) Q:'+BARI  D
  1.  . . F BARJ=".01",".02",".03" S DAT(BARI,BARJ)=$$GET1^DIQ(90056.05,BARI,BARJ)
  1.  K BARI,BARJ
  1.  K DAT("ID") ;node generated by XBDIQ1
  1.  ; build index of types with conversion code  DAT("ID")="S X=F(X)"
  1.  S DATDA=0
  1.  F  S DATDA=$O(DAT(DATDA)) Q:DATDA'>0  D
  1.  . ; replace | with ^ for routine tag^rou references
  1.  . S DAT(DAT(DATDA,.01))=$TR(DAT(DATDA,.03),"|","^")
  1.  ;
  1.  ;pull import record list into ^TMP($J,"SE")
  1.  K ^TMP($J,"SE")
  1.  W !,"Processing Segment Elements into Values",!
  1.  D ENPM^XBDIQ1(90056.0202,"IMPDA,0",".01","^TMP($J,""SE"",")
  1.  S RECM="^TMP($J,""SE"")"
  1.  ; scan import records
  1.  S COUNT=1
  1.  S RECDA=0
  1.  F  S RECDA=$O(@RECM@(RECDA)) Q:RECDA'>0  D
  1.  . W:'(COUNT#10) "."
  1.  . W:'(COUNT#500) "  ",COUNT,!
  1.  . S COUNT=COUNT+1
  1.  . K REC
  1.  . D ENP^XBDIQ1(90056.0202,"IMPDA,RECDA",".02;.03;.04;1.01","REC(")
  1.  . S PATHS=REC(.04)
  1.  . D LOADTR
  1.  W " ",COUNT,!
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. LOADTR ;
  1.  ; load element parsing specifications
  1.  S:'$D(E) E="|"
  1.  K ^TMP($J,"ELM"),ARRAY
  1.  S SEGXDA=$P(PATHS,",",2)
  1.  ; pull records id, path, and value
  1.  D ENPM^XBDIQ1(90056.0102,"TRDA,SEGXDA,0",".01","^TMP($J,""ELM"",")
  1.  S ELMDA=0
  1.  F  S ELMDA=$O(^TMP($J,"ELM",ELMDA)) Q:ELMDA'>0  D
  1.  . K ELM
  1.  . D ENP^XBDIQ1(90056.0102,"TRDA,SEGXDA,ELMDA",".02;.03;.04;.07;.09","ELM(","I")
  1.  . S SEQ=ELM(.03)
  1.  . S X=$P(REC(1.01),E,SEQ+1)
  1.  . D CONVERT
  1.  . ; store converted value in array
  1.  . S ARRAY(SEQ)=X
  1.  ; set array elements into WP field of record
  1.  K ^BAREDI("I",DUZ(2),IMPDA,20,RECDA,10)
  1.  S I=$O(ARRAY(""),-1)
  1.  S ^BAREDI("I",DUZ(2),IMPDA,20,RECDA,10,0)="^^"_I_"^"_I_"^"_DT
  1.  F ELMDA=1:1:I S ^BAREDI("I",DUZ(2),IMPDA,20,RECDA,10,ELMDA,0)=ARRAY(ELMDA)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. CONVERT ;
  1.  ; Convert incoming data according to data type(s)
  1.  I $L(ELM(.07)) D TABLE Q
  1.  I $L(ELM(.09,"I")) D STNDTBL Q
  1.  I $D(DAT(ELM(.04))) S XX=DAT(ELM(.04)),XX=$TR(XX,"|","^") X XX Q
  1.  S X=X
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. TABLE ;
  1.  ; perform lookup on table ; ELM(.07) contains path to table   
  1.  ;S X=X_"-TABLE-"_ELM(.07)
  1.  S MCODE=$$GET1^DIQ(90056.0105,ELM(.07),.03)
  1.  S MCODE=$TR(MCODE,"|","^")
  1.  I $L(MCODE) X MCODE Q  ;table is using a routine to resolve X
  1.  S X=$$FIND(90056.0106,ELM(.07),X) ; regular table entry
  1.  Q
  1.  ; *******************************************************************
  1.  ;
  1. STNDTBL ; EP - Pull value from A/R EDI TABLES File
  1.  S MCODE=$$GET1^DIQ(90056.04,ELM(.09,"I"),.03)    ; Processing code
  1.  S MCODE=$TR(MCODE,"|","^")
  1.  I $L(MCODE) X MCODE Q
  1.  ; Find standard tables entry
  1.  S DA(1)=ELM(.09,"I")
  1.  S DIC="^BARETBL("_DA(1)_",1,"
  1.  S DIC(0)="XZ"
  1.  D ^DIC
  1.  I +Y<0 S X=X_" | No Match" Q
  1.  S X=X_" | "_$P(Y(0),U,2)
  1.  Q
  1.  ; *******************************************************************
  1.  ;
  1. DT ;
  1.  ; Convert date to readable format for HIPAA 835
  1.  ; ISA09 comes as YYMMDD all other elements are YYYYMMDD
  1.  S X=$S($L(X)=6:($E(X,3,4)_"/"_$E(X,5,6)_"/"_$E(X,1,2)),1:$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4))
  1.  S %DT="X"
  1.  D ^%DT,DD^%DT
  1.  S X=Y
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. CLMCODE ; EP
  1.  ; .03 (processing routine) for this data type of this element
  1.  ; find claim reason code 
  1.  Q:X=""
  1.  K DIC,DA
  1.  S DIC=$$DIC^XBDIQ1(90056.0107)
  1.  S DA(1)=TRDA
  1.  S DIC(0)="X"
  1.  D ^DIC
  1.  I Y'>0 S X=X_" | No Match" Q
  1.  S XDA=+Y
  1.  S X=X_" | "_$$VAL^XBDIQ1(90056.0107,"TRDA,XDA",.02)
  1.  Q
  1.  ; *******************************************************************
  1.  ;
  1. CLMADJCD ; EP
  1.  ; .03 (processing routine) for this data type of this element
  1.  ; Find standard claim level adjustment code
  1.  S X=$TR(X," ")  ;BAR*1.8*5 IM26444
  1.  Q:X=""
  1.  K DIC,DA
  1.  I +X>0 S X=+X               ;IM13518
  1.  S DIC="^BARADJ("
  1.  S DIC(0)="ZX"
  1.  K DD,DO
  1.  D ^DIC
  1.  I +Y<0 S X=X_" | No Match" Q
  1.  S XDA=+Y
  1.  S X=X_" | "_$$GET1^DIQ(90056.06,XDA,.02)
  1.  Q
  1.  ; *******************************************************************
  1.  ;
  1. RMKCODE ;
  1.  ; find remark code
  1.  Q:X=""
  1.  S X=X_" | Remark Code"
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. HRMKCD ; EP
  1.  ; This line tag called by .03 field in A/R EDI TABLES File
  1.  ; Processing routine for Remark Code elements to look up in RPMS File
  1.  Q:X=""
  1.  K DIC,DA
  1.  S DIC="^BARMKCD("
  1.  S DIC(0)="ZX"
  1.  K DD,DO
  1.  D ^DIC
  1.  I +Y<0 S X=X_" | No Match" Q
  1.  S XDA=+Y
  1.  S X=X_" | "_$$GET1^DIQ(90056.23,XDA,.02)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. LQCD ; EP
  1.  ; This line tag called by .03 field in A/R EDI TABLES File
  1.  ; Processing routine for Remark or NCPDP Reject Payment Codes.
  1.  ; Whichever is passed in on LQ02
  1.  ;
  1.  ; BARCTYP = HE = Remark Code
  1.  ; BARCTYP = RX = NCPDP Reject/Payment Code
  1.  Q:X=""
  1.  S BARCTYP=$P(REC(1.01),E,2)    ; Type of Code
  1.  I BARCTYP="HE" D HRMKCD Q
  1.  I BARCTYP'="RX" D  Q
  1.  . S X=X_" | No Match"
  1.  K DIC,DA
  1.  S DIC="^ABSPF(9002313.93,"
  1.  S DIC(0)="ZX"
  1.  K DD,DO
  1.  D ^DIC
  1.  I +Y<0 S X=X_" | No Match" Q
  1.  S XDA=+Y
  1.  S X=X_" | "_$$GET1^DIQ(9002313.93,XDA,.02)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. PLVCODE ;
  1.  ; find provider level reason code
  1.  ; Not called for HIPAA - regular table entry.
  1.  Q:X=""
  1.  K DIC,DA
  1.  S DIC=$$DIC^XBDIQ1(90056.0108)
  1.  S DA(1)=TRDA
  1.  S DIC(0)="X"
  1.  D ^DIC
  1.  I Y'>0 S X=X_" | No PLV match" Q
  1.  S XDA=+Y,X=X_" | "_$$VAL^XBDIQ1(90056.0108,"TRDA,XDA",.02)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. FIND(FILE,PATH,X)       ;
  1.  ;find X in file and return X_VALUE
  1.  K DIC,DA
  1.  I X="" Q X
  1.  ;
  1.  S DIC=$$DIC^XBDIQ1(FILE)
  1.  S DIC(0)="XZ"
  1.  F I=1:1 S DAZ(I)=$P(PATH,",",I) Q:DAZ(I)'>0
  1.  F C=1:1:I-1 S DA(C)=DAZ(I-C)
  1.  D ^DIC
  1.  I Y'>0 S X=X_" | NO MATCH" Q X
  1.  S X=X_" | "_$P(Y(0),U,2)
  1.  Q X
  1.  ;start new code bar*1.8*20 REQ1
  1. CHKS(IMPDA) ;
  1.  N BARCTMP
  1.  S I=0,BARCCNT=1
  1.  ;B "S+"
  1.  F  S I=$O(^BAREDI("I",DUZ(2),IMPDA,15,I)) Q:'I  D
  1.  .S IREC=$G(^BAREDI("I",DUZ(2),IMPDA,15,I,0))
  1.  .Q:$P(IREC,E)'="ST"
  1.  .S $P(BARCTMP(BARCCNT),U,2)=$P(IREC,E,3)  ;ST control#
  1.  .S I=I+1
  1.  .S $P(BARCTMP(BARCCNT),U,4)=$P(^BAREDI("I",DUZ(2),IMPDA,15,I,0),E,2)  ;BPR01
  1.  .S $P(BARCTMP(BARCCNT),U,3)=$P(^BAREDI("I",DUZ(2),IMPDA,15,I,0),E,3)  ;BPR02
  1.  .S $P(BARCTMP(BARCCNT),U,5)=($P(^BAREDI("I",DUZ(2),IMPDA,15,I,0),E,17)-17000000)  ;BPR16
  1.  .S I=I+1
  1.  .;I $P(^BAREDI("I",DUZ(2),IMPDA,15,I,0),E)="NTE" S I=I+1  ;check for NTE that PNC includes here  ;bar*1.8*21
  1.  .;start new code bar*1.8*21 IHS/SD/SDR
  1.  .S BARQ=0
  1.  .F  D  Q:BARQ=1
  1.  ..I $P(^BAREDI("I",DUZ(2),IMPDA,15,I,0),E)="NTE" S I=I+1
  1.  ..E  S BARQ=1
  1.  .;end new code bar*1.8*21
  1.  .S $P(BARCTMP(BARCCNT),U)=$P(^BAREDI("I",DUZ(2),IMPDA,15,I,0),E,3)  ;TRN02
  1.  .S I=I+2
  1.  .S $P(BARCTMP(BARCCNT),U,6)=$P(^BAREDI("I",DUZ(2),IMPDA,15,I,0),E,3)  ;N102
  1.  .S $P(BARCTMP(BARCCNT),U,11)="UNF"
  1.  .S BARCCNT=+$G(BARCCNT)+1
  1.  S BARCCNT=0
  1.  D PLB
  1.  F  S BARCCNT=$O(BARCTMP(BARCCNT)) Q:'BARCCNT  D
  1.  .K DIC,DIE,DIR,X,Y,DA
  1.  .S DA(1)=IMPDA
  1.  .S DIC="^BAREDI(""I"","_DUZ(2)_","_DA(1)_",5,"
  1.  .S DIC("P")=$P(^DD(90056.02,5,0),U,2)
  1.  .S DIC(0)=""
  1.  .S X=$P(BARCTMP(BARCCNT),U)
  1.  .S DIC("DR")=".02////"_$P(BARCTMP(BARCCNT),U,2)
  1.  .S DIC("DR")=DIC("DR")_";.03////"_$P(BARCTMP(BARCCNT),U,3)
  1.  .S DIC("DR")=DIC("DR")_";.04////"_$P(BARCTMP(BARCCNT),U,4)
  1.  .S DIC("DR")=DIC("DR")_";.05////"_$P(BARCTMP(BARCCNT),U,5)
  1.  .S DIC("DR")=DIC("DR")_";.06////"_$P(BARCTMP(BARCCNT),U,6)
  1.  .S DIC("DR")=DIC("DR")_";.09////"_$P(BARCTMP(BARCCNT),U,9)
  1.  .S DIC("DR")=DIC("DR")_";.11////"_$P(BARCTMP(BARCCNT),U,11)
  1.  .K DD,DO
  1.  .D FILE^DICN
  1.  Q
  1. PLB ; EP
  1.  N BARCDA,CNT,BARVCK,BARSEG,BARSCK
  1.  S BARCDA=0
  1.  S (BARVCK,BARSCK)=""
  1.  F CNT=1:1 S BARCDA=$O(^BAREDI("I",DUZ(2),IMPDA,15,BARCDA)) Q:'BARCDA  D
  1.  .W:'(CNT#1000) "."
  1.  .S BAR15=^BAREDI("I",DUZ(2),IMPDA,15,BARCDA,0)
  1.  .S BARSEG=$P(BAR15,E)
  1.  .S:BARSEG="TRN" BARVCK=$P(BAR15,E,3) ;Check Number
  1.  .Q:BARSEG'="PLB"                     ;Only want PLB
  1.  .S BARCCNT=0
  1.  .F  S BARCCNT=$O(BARCTMP(BARCCNT)) Q:'BARCCNT  D
  1.  ..Q:($P($G(BARCTMP(BARCCNT)),U)'=BARVCK)  ;find check number in temp array
  1.  ..S $P(BARCTMP(BARCCNT),U,9)=+$P(BARCTMP(BARCCNT),U,9)+$P(BAR15,E,5)  ;PLB amount PLB04
  1.  ..S $P(BARCTMP(BARCCNT),U,9)=+$P(BARCTMP(BARCCNT),U,9)+$P(BAR15,E,7)  ;PLB amount PLB06
  1.  ..S $P(BARCTMP(BARCCNT),U,9)=+$P(BARCTMP(BARCCNT),U,9)+$P(BAR15,E,9)  ;PLB amount PLB08
  1.  ..S $P(BARCTMP(BARCCNT),U,9)=+$P(BARCTMP(BARCCNT),U,9)+$P(BAR15,E,11)  ;PLB amount PLB10
  1.  ..S $P(BARCTMP(BARCCNT),U,9)=+$P(BARCTMP(BARCCNT),U,9)+$P(BAR15,E,13)  ;PLB amount PLB12
  1.  ..S $P(BARCTMP(BARCCNT),U,9)=+$P(BARCTMP(BARCCNT),U,9)+$P(BAR15,E,15)  ;PLB amount PLB14
  1.  Q
  1.  ;end new code REQ1