BAR50P03 ; IHS/SD/LSL - EDI CLAIM & POSTING ELEMENTS ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,20,21,23**;OCT 26,2005
;
; IHS/SD/LSL - 09/16/03 - V1.7 Patch 4 - HIPAA
; p.ottis beta p23 11/27/2013 compare num values, not strings
; ********************************************************************
;
EN(TRDA,IMPDA) ; EP
; Process segments into claims with postable data
D SETVAR
W !,"Processing Record Values into Postable Claims",!
S COUNT=1
K ^TMP($J,"REC"),IMGDA,CLMDA
;clear 'processing image' & 'claims'
K ^BAREDI("I",DUZ(2),IMPDA,30)
K ^BAREDI("I",DUZ(2),IMPDA,40)
S ^BAREDI("I",DUZ(2),IMPDA,40,0)="^^^"_DT_"^"
S (CLMDA,LINE)=0
; pull records to scan for variable pulling and processing
D ENPM^XBDIQ1(90056.0202,"IMPDA,0",".01;.03;.04;1.01","^TMP($J,""REC"",")
S REC="^TMP($J,""REC"")"
; loop and check if record has posting variables
; if so, processes the segment, elements, variables' pocessing
; build claims demographics & adjustments
S RECDA=""
F S RECDA=$O(@REC@(RECDA)) Q:RECDA'>0 D
. S SEGDA=$P(@REC@(RECDA,.04),",",2) ;pull segment da from path
.;W !,REC_"("_RECDA_")="_@REC@(RECDA,.03)
. ; check index for variables to pull
. I '$D(^BAREDI("1T",TRDA,10,SEGDA,10,"C")) Q
. D PULLVARS
;
W " ",COUNT,!
; set claims' status to B 'Built'
K DIE,DIC,DR,DA
S DIE=$$DIC^XBDIQ1(90056.0205)
S DA(1)=IMPDA
S DR=".02////B"
S CLMDA=0
S CLPAMT=0 K CLP ;bar*1.8*20 REQ5
F S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:CLMDA'>0 D
.S DA=CLMDA
.D ^DIE
.;start new code bar*1.8*20 REQ5
.S IENS=CLMDA_","_IMPDA_","
.S CLPAMT=$$GET1^DIQ(90056.0205,IENS,".04")
.S CLMCK=$$GET1^DIQ(90056.0205,IENS,201)
.S CLP(CLMCK)=+$G(CLP(CLMCK))+CLPAMT
S CKDA=0,FLG=0
W $$EN^BARVDF("IOF")
W !,"Checking balance of each check within ERA...",!
F S CKDA=$O(^BAREDI("I",DUZ(2),IMPDA,5,CKDA)) Q:'CKDA D
.S IENS=CKDA_","_IMPDA_","
.S CK=$$GET1^DIQ(90056.02011,IENS,".01")
.S CKAMT=$$GET1^DIQ(90056.02011,IENS,".03")
.S PLBAMT=$$GET1^DIQ(90056.02011,IENS,".09")
.W:FLG=0 !?40,"(CLP04)",?55,"(PLB)",?70,"(BPR02)"
.;old code
.;I (+$G(CLP(CK))-PLBAMT)'=CKAMT W !,"Check "_CK_" does NOT balance "
.;I (+$G(CLP(CK))-PLBAMT)=CKAMT W !,"Check "_CK_" balances "
.I (+$G(CLP(CK))-PLBAMT)'=+CKAMT W !,"Check "_CK_" does NOT balance " ;11/27/2013 compare num values, not strings
.I (+$G(CLP(CK))-PLBAMT)=+CKAMT W !,"Check "_CK_" balances " ;11/27/2013 compare num values, not strings
.W ?35,$J($FN(+$G(CLP(CK)),",",2),12)_" - "_$S(+$$GET1^DIQ(90056.02011,IENS,".09")=0:" NO PLB ",1:$J($FN(+PLBAMT,",",2),10))_" <> "_$J($FN(+CKAMT,",",2),12),!
.S FLG=1
;end new code REQ5
;
Q
; *********************************************************************
;
;
Q
PULLVARS ;EP
; pull and process posting variables from segments
M XREC=@REC@(RECDA)
;XREC(1.01)=raw segment XREC(.04) is path
;
S D0S=XREC(.04)_",0" ; path,0
; pull elements and build Sequence array SEQ(piece)=varname
K ELM,SEQ
D ENPM^XBDIQ1(90056.0102,D0S,".03;.08","ELM(")
S ELMDA=0
F S ELMDA=$O(ELM(ELMDA)) Q:ELMDA'>0 D
. Q:ELM(ELMDA,.08)=""
. S SEQ(ELM(ELMDA,.03)+1)=ELM(ELMDA,.08)
;
;BAR*1.8*1 SRS PATCH 1 ADDENDUM
;NEED TO CLEAR OUT VARIABLES SO NONE
;LINGER FROM SEGMENT REPEATS
S PIECE=""
F S PIECE=$O(SEQ(PIECE)) Q:PIECE="" D
.S VARNM=SEQ(PIECE)
.K @VARNM
;END BAR*1.8*1 SRS PATCH 1 ADDENDUM
; store lines into 'PROCESSING IMAGE'
; store claim information
K RECORD ; RECORD IMAGE
;initialize image
;initialize Claims
D ENP^XBDIQ1(90056.0202,"IMPDA,RECDA",10,"RECORD(")
S PIECE=0
F S PIECE=$O(SEQ(PIECE)) Q:PIECE'>0 D
. S VARNM=SEQ(PIECE)
. S @VARNM=$G(^BAREDI("I",DUZ(2),IMPDA,20,RECDA,10,PIECE-1,0))
. S VARVAL=RECORD(10,PIECE-1)
. D IMAGE
. ; the next line executes the table routine if the
. ; variable has a routine to perform entered into the tables
. ; otherwise function point processing
. I $D(VAR(VARNM)) D
..; W !,XREC(.03)
..; W !,VAR(VARNM)
.. D @VAR(VARNM)
Q
; *********************************************************************
;
IMAGE ; EP
; increment and store list of processing variables into image
Q:'$L(VARVAL)
S X=VARNM_" "_@VARNM
S IMGDA=$G(IMGDA)+1
S ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)=X
Q
; *********************************************************************
;
SETVAR ; EP
; pull names of variables for triggering processing points
; as VAR("NEWBILL")="NEWBILL^BAREDPA3"
K VAR,VARM
D ENPM^XBDIQ1(90056.0111,"TRDA,0",".01;.02","VARM(")
S VARDA=""
F S VARDA=$O(VARM(VARDA)) Q:VARDA'>0 D
. S NM=VARM(VARDA,.01)
. S ROU=VARM(VARDA,.02)
. S ROU=$TR(ROU,"|","^")
. S VAR(NM)=ROU
K VARM
Q
BAR50P03 ; IHS/SD/LSL - EDI CLAIM & POSTING ELEMENTS ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,20,21,23**;OCT 26,2005
+2 ;
+3 ; IHS/SD/LSL - 09/16/03 - V1.7 Patch 4 - HIPAA
+4 ; p.ottis beta p23 11/27/2013 compare num values, not strings
+5 ; ********************************************************************
+6 ;
EN(TRDA,IMPDA) ; EP
+1 ; Process segments into claims with postable data
+2 DO SETVAR
+3 WRITE !,"Processing Record Values into Postable Claims",!
+4 SET COUNT=1
+5 KILL ^TMP($JOB,"REC"),IMGDA,CLMDA
+6 ;clear 'processing image' & 'claims'
+7 KILL ^BAREDI("I",DUZ(2),IMPDA,30)
+8 KILL ^BAREDI("I",DUZ(2),IMPDA,40)
+9 SET ^BAREDI("I",DUZ(2),IMPDA,40,0)="^^^"_DT_"^"
+10 SET (CLMDA,LINE)=0
+11 ; pull records to scan for variable pulling and processing
+12 DO ENPM^XBDIQ1(90056.0202,"IMPDA,0",".01;.03;.04;1.01","^TMP($J,""REC"",")
+13 SET REC="^TMP($J,""REC"")"
+14 ; loop and check if record has posting variables
+15 ; if so, processes the segment, elements, variables' pocessing
+16 ; build claims demographics & adjustments
+17 SET RECDA=""
+18 FOR
SET RECDA=$ORDER(@REC@(RECDA))
IF RECDA'>0
QUIT
Begin DoDot:1
+19 ;pull segment da from path
SET SEGDA=$PIECE(@REC@(RECDA,.04),",",2)
+20 ;W !,REC_"("_RECDA_")="_@REC@(RECDA,.03)
+21 ; check index for variables to pull
+22 IF '$DATA(^BAREDI("1T",TRDA,10,SEGDA,10,"C"))
QUIT
+23 DO PULLVARS
End DoDot:1
+24 ;
+25 WRITE " ",COUNT,!
+26 ; set claims' status to B 'Built'
+27 KILL DIE,DIC,DR,DA
+28 SET DIE=$$DIC^XBDIQ1(90056.0205)
+29 SET DA(1)=IMPDA
+30 SET DR=".02////B"
+31 SET CLMDA=0
+32 ;bar*1.8*20 REQ5
SET CLPAMT=0
KILL CLP
+33 FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA))
IF CLMDA'>0
QUIT
Begin DoDot:1
+34 SET DA=CLMDA
+35 DO ^DIE
+36 ;start new code bar*1.8*20 REQ5
+37 SET IENS=CLMDA_","_IMPDA_","
+38 SET CLPAMT=$$GET1^DIQ(90056.0205,IENS,".04")
+39 SET CLMCK=$$GET1^DIQ(90056.0205,IENS,201)
+40 SET CLP(CLMCK)=+$GET(CLP(CLMCK))+CLPAMT
End DoDot:1
+41 SET CKDA=0
SET FLG=0
+42 WRITE $$EN^BARVDF("IOF")
+43 WRITE !,"Checking balance of each check within ERA...",!
+44 FOR
SET CKDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,5,CKDA))
IF 'CKDA
QUIT
Begin DoDot:1
+45 SET IENS=CKDA_","_IMPDA_","
+46 SET CK=$$GET1^DIQ(90056.02011,IENS,".01")
+47 SET CKAMT=$$GET1^DIQ(90056.02011,IENS,".03")
+48 SET PLBAMT=$$GET1^DIQ(90056.02011,IENS,".09")
+49 IF FLG=0
WRITE !?40,"(CLP04)",?55,"(PLB)",?70,"(BPR02)"
+50 ;old code
+51 ;I (+$G(CLP(CK))-PLBAMT)'=CKAMT W !,"Check "_CK_" does NOT balance "
+52 ;I (+$G(CLP(CK))-PLBAMT)=CKAMT W !,"Check "_CK_" balances "
+53 ;11/27/2013 compare num values, not strings
IF (+$GET(CLP(CK))-PLBAMT)'=+CKAMT
WRITE !,"Check "_CK_" does NOT balance "
+54 ;11/27/2013 compare num values, not strings
IF (+$GET(CLP(CK))-PLBAMT)=+CKAMT
WRITE !,"Check "_CK_" balances "
+55 WRITE ?35,$JUSTIFY($FNUMBER(+$GET(CLP(CK)),",",2),12)_" - "_$SELECT(+$$GET1^DIQ(90056.02011,IENS,".09")=0:" NO PLB ",1:$JUSTIFY($FNUMBER(+PLBAMT,",",2),10))_" <> "_$JUSTIFY($FNUMBER(+CKAMT,",",2),12),!
+56 SET FLG=1
End DoDot:1
+57 ;end new code REQ5
+58 ;
+59 QUIT
+60 ; *********************************************************************
+61 ;
+62 ;
+63 QUIT
PULLVARS ;EP
+1 ; pull and process posting variables from segments
+2 MERGE XREC=@REC@(RECDA)
+3 ;XREC(1.01)=raw segment XREC(.04) is path
+4 ;
+5 ; path,0
SET D0S=XREC(.04)_",0"
+6 ; pull elements and build Sequence array SEQ(piece)=varname
+7 KILL ELM,SEQ
+8 DO ENPM^XBDIQ1(90056.0102,D0S,".03;.08","ELM(")
+9 SET ELMDA=0
+10 FOR
SET ELMDA=$ORDER(ELM(ELMDA))
IF ELMDA'>0
QUIT
Begin DoDot:1
+11 IF ELM(ELMDA,.08)=""
QUIT
+12 SET SEQ(ELM(ELMDA,.03)+1)=ELM(ELMDA,.08)
End DoDot:1
+13 ;
+14 ;BAR*1.8*1 SRS PATCH 1 ADDENDUM
+15 ;NEED TO CLEAR OUT VARIABLES SO NONE
+16 ;LINGER FROM SEGMENT REPEATS
+17 SET PIECE=""
+18 FOR
SET PIECE=$ORDER(SEQ(PIECE))
IF PIECE=""
QUIT
Begin DoDot:1
+19 SET VARNM=SEQ(PIECE)
+20 KILL @VARNM
End DoDot:1
+21 ;END BAR*1.8*1 SRS PATCH 1 ADDENDUM
+22 ; store lines into 'PROCESSING IMAGE'
+23 ; store claim information
+24 ; RECORD IMAGE
KILL RECORD
+25 ;initialize image
+26 ;initialize Claims
+27 DO ENP^XBDIQ1(90056.0202,"IMPDA,RECDA",10,"RECORD(")
+28 SET PIECE=0
+29 FOR
SET PIECE=$ORDER(SEQ(PIECE))
IF PIECE'>0
QUIT
Begin DoDot:1
+30 SET VARNM=SEQ(PIECE)
+31 SET @VARNM=$GET(^BAREDI("I",DUZ(2),IMPDA,20,RECDA,10,PIECE-1,0))
+32 SET VARVAL=RECORD(10,PIECE-1)
+33 DO IMAGE
+34 ; the next line executes the table routine if the
+35 ; variable has a routine to perform entered into the tables
+36 ; otherwise function point processing
+37 IF $DATA(VAR(VARNM))
Begin DoDot:2
+38 ; W !,XREC(.03)
+39 ; W !,VAR(VARNM)
+40 DO @VAR(VARNM)
End DoDot:2
End DoDot:1
+41 QUIT
+42 ; *********************************************************************
+43 ;
IMAGE ; EP
+1 ; increment and store list of processing variables into image
+2 IF '$LENGTH(VARVAL)
QUIT
+3 SET X=VARNM_" "_@VARNM
+4 SET IMGDA=$GET(IMGDA)+1
+5 SET ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)=X
+6 QUIT
+7 ; *********************************************************************
+8 ;
SETVAR ; EP
+1 ; pull names of variables for triggering processing points
+2 ; as VAR("NEWBILL")="NEWBILL^BAREDPA3"
+3 KILL VAR,VARM
+4 DO ENPM^XBDIQ1(90056.0111,"TRDA,0",".01;.02","VARM(")
+5 SET VARDA=""
+6 FOR
SET VARDA=$ORDER(VARM(VARDA))
IF VARDA'>0
QUIT
Begin DoDot:1
+7 SET NM=VARM(VARDA,.01)
+8 SET ROU=VARM(VARDA,.02)
+9 SET ROU=$TRANSLATE(ROU,"|","^")
+10 SET VAR(NM)=ROU
End DoDot:1
+11 KILL VARM
+12 QUIT
