Routine: BAREDP03

BAREDP03 ; IHS/SD/LSL - EDI CLAIM & POSTING ELEMENTS ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,20**;OCT 26,2005

 ; IHS/SD/LSL - 09/16/03 - V1.7 Patch 4 - HIPAA

 ; ********************************************************************

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

 . ; 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)"

 .I (+$G(CLP(CK))-PLBAMT)'=CKAMT W !,"Check "_CK_" does NOT balance "

 .I (+$G(CLP(CK))-PLBAMT)=CKAMT W !,"Check "_CK_" balances "

 .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

 ; *********************************************************************

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 @VAR(VARNM)

 ; *********************************************************************

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

 ; *********************************************************************

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

BAREDP03  ; IHS/SD/LSL - EDI CLAIM & POSTING ELEMENTS ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,20**;OCT 26,2005

 +2       ;

 +3       ; IHS/SD/LSL - 09/16/03 - V1.7 Patch 4 - HIPAA

 +4       ;

 +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      ; check index for variables to pull

 +21               IF '$DATA(^BAREDI("1T",TRDA,10,SEGDA,10,"C"))

                       QUIT

 +22               DO PULLVARS

               End DoDot:1

 +23      ;

 +24       WRITE " ",COUNT,!

 +25      ; set claims' status to B 'Built'

 +26       KILL DIE,DIC,DR,DA

 +27       SET DIE=$$DIC^XBDIQ1(90056.0205)

 +28       SET DA(1)=IMPDA

 +29       SET DR=".02////B"

 +30       SET CLMDA=0

 +31      ;bar*1.8*20 REQ5

           SET CLPAMT=0

           KILL CLP

 +32       FOR

               SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA))

               IF CLMDA'>0

                   QUIT

               Begin DoDot:1

 +33               SET DA=CLMDA

 +34               DO ^DIE

 +35      ;start new code bar*1.8*20 REQ5

 +36               SET IENS=CLMDA_","_IMPDA_","

 +37               SET CLPAMT=$$GET1^DIQ(90056.0205,IENS,".04")

 +38               SET CLMCK=$$GET1^DIQ(90056.0205,IENS,201)

 +39               SET CLP(CLMCK)=+$GET(CLP(CLMCK))+CLPAMT

               End DoDot:1

 +40       SET CKDA=0

           SET FLG=0

 +41       WRITE $$EN^BARVDF("IOF")

 +42       WRITE !,"Checking balance of each check within ERA...",!

 +43       FOR

               SET CKDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,5,CKDA))

               IF 'CKDA

                   QUIT

               Begin DoDot:1

 +44               SET IENS=CKDA_","_IMPDA_","

 +45               SET CK=$$GET1^DIQ(90056.02011,IENS,".01")

 +46               SET CKAMT=$$GET1^DIQ(90056.02011,IENS,".03")

 +47               SET PLBAMT=$$GET1^DIQ(90056.02011,IENS,".09")

 +48               IF FLG=0

                       WRITE !?40,"(CLP04)",?55,"(PLB)",?70,"(BPR02)"

 +49               IF (+$GET(CLP(CK))-PLBAMT)'=CKAMT

                       WRITE !,"Check "_CK_" does NOT balance "

 +50               IF (+$GET(CLP(CK))-PLBAMT)=CKAMT

                       WRITE !,"Check "_CK_" balances "

 +51               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),!

 +52               SET FLG=1

               End DoDot:1

 +53      ;end new code REQ5

 +54      ;

 +55       QUIT

 +56      ; *********************************************************************

 +57      ;

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))

                       DO @VAR(VARNM)

               End DoDot:1

 +38       QUIT

 +39      ; *********************************************************************

 +40      ;

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

BAREDP03.m