ABMPPFLR.m

ABMPPFLR ; IHS/SD/SDR - Prior Payments/Adjustments filer (CE) ;

 ;;2.6;IHS Third Party Billing;**1,19**;NOV 12, 2009;Build 300

 ;

 ; ABMPL(Insurer priority, Insurer IEN)=13 multiple IEN ^ Billing status

 ; ABMPP(Insurer IEN, "P" or "A", Counter)=Amount ^ Adj Category ^ Trans. Type ^ Std Adj. Reason

 ;

 ; IHS/SD/SDR - v2.5 p13 - IM25471 - Changes for CAS when SAR=A2

 ; IHS/SD/SDR - v2.6 p1 - HEAT414 - <UNDEF>EN+29^ABMPPFLR

 ;IHS/SD/SDR - 2.6*19 - HEAT168248 - Removes payment multiple completely so residual entries from previous run don't mess up current transactions

 ;

EN ;EP

 S ABMSTAT=""

 ; bill status x-ref

 F  S ABMSTAT=$O(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),ABMSTAT)) Q:ABMSTAT=""  D

 .Q:ABMSTAT="X"

 .S ABMBIEN=0

 .F  S ABMBIEN=$O(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),ABMSTAT,ABMBIEN)) Q:+ABMBIEN=0  D

 ..S ABMAINS=$P($G(^ABMDBILL(DUZ(2),ABMBIEN,0)),U,8)  ;active insurer

 ..Q:'$D(ABMPP(ABMAINS))  ;quit if no data for insurer

 ..K ^ABMDBILL(DUZ(2),ABMBIEN,3)  ;abm*2.6*19 HEAT168248

 ..K ABMBPIEN

 ..S ABMCAT=""

 ..F  S ABMCAT=$O(ABMPP(ABMAINS,ABMCAT)) Q:ABMCAT=""  D

 ...S ABMLN=0

 ...F  S ABMLN=$O(ABMPP(ABMAINS,ABMCAT,ABMLN)) Q:+ABMLN=0  D

 ....S ABMLAMT=$P(ABMPP(ABMAINS,ABMCAT,ABMLN),U)  ;amt

 ....I +ABMLAMT=0,$P($G(ABMPP(ABMAINS,ABMCAT,ABMLN)),U,6)'="" D  Q

 .....S DA(1)=ABMBIEN

 .....S DIK="^ABMDBILL(DUZ(2),DA(1),3,"

 .....S DA=$P(ABMPP(ABMAINS,ABMCAT,ABMLN),U,6)

 .....D ^DIK

 ....Q:+ABMLAMT=0

 ....S ABMADJC=$P($G(ABMPP(ABMAINS,ABMCAT,ABMLN)),U,2)  ;adj category

 ....S ABMADJT=$P($G(ABMPP(ABMAINS,ABMCAT,ABMLN)),U,3)  ;trans type

 ....S ABMSAR=$S($P($G(ABMPP(ABMAINS,ABMCAT,ABMLN)),U,4)'="":$P(ABMPP(ABMAINS,ABMCAT,ABMLN),U,4),1:"@")  ;std adj reason

 ....;S ABMBPIEN=$P($G(ABMPP(ABMAINS,ABMCAT,ABMLN)),U,6)  ;IEN of entry  ;abm*2.6*19 IHS/SD/SDR HEAT168248

 ....S ABMBPIEN=0  ;treat like a new entry every time - was killed above, as well as entries could have been edited, merged  ;abm*2.6*19 IHS/SD/SDR HEAT168248

 ....I +ABMBPIEN=0 D  ;file as new entry

 .....D ^XBFMK

 .....S DA(1)=ABMBIEN

 .....;S X=ABMOPDT  ;abm*2.6*1 HEAT414

 .....S X=$S($G(ABMOPDT)'="":ABMOPDT,1:DT)  ;abm*2.6*1 HEAT414

 .....S DIC="^ABMDBILL(DUZ(2),"_DA(1)_",3,"

 .....S DIC(0)="LI"

 .....S DIC("P")=$P(^DD(9002274.4,3,0),U,2)

 .....K DD,DO D FILE^DICN

 .....S ABMBPIEN=+Y

 .....S $P(ABMPP(ABMAINS,ABMCAT,ABMLN),U,6)=ABMBPIEN

 ....K X,Y,DIC,DIE,DR,DA

 ....S DA(1)=ABMBIEN

 ....S DIE="^ABMDBILL(DUZ(2),DA(1),3,"

 ....S DA=ABMBPIEN

 ....I ABMCAT="P" D

 .....S DR=".02///"_ABMLAMT_";.1///"_ABMLAMT

 ....I ABMCAT="A" D

 .....I ABMADJC=3 S DR=".06///"_ABMLAMT

 .....I ABMADJC=4 S DR=".07///"_ABMLAMT

 .....I ABMADJC=13 S DR=".03///"_ABMLAMT

 .....I ABMADJC=14 S DR=".04///"_ABMLAMT

 .....I ABMADJC=15 S DR=".09///"_ABMLAMT

 .....I ABMADJC=16 S DR=".12///"_ABMLAMT

 .....I ABMADJC=19 S DR=".13///"_ABMLAMT

 .....I ABMADJC=20 S DR=".14///"_ABMLAMT

 .....S DR=$G(DR)_";.15///"_ABMADJC_";.16///"_ABMADJT_";.17////"_ABMSAR

 ....D ^DIE

 S ABMSPLFG=1

 Q

ABMPPFLR  ; IHS/SD/SDR - Prior Payments/Adjustments filer (CE) ;

 +1       ;;2.6;IHS Third Party Billing;**1,19**;NOV 12, 2009;Build 300

 +2       ;

 +3       ; ABMPL(Insurer priority, Insurer IEN)=13 multiple IEN ^ Billing status

 +4       ; ABMPP(Insurer IEN, "P" or "A", Counter)=Amount ^ Adj Category ^ Trans. Type ^ Std Adj. Reason

 +5       ;

 +6       ; IHS/SD/SDR - v2.5 p13 - IM25471 - Changes for CAS when SAR=A2

 +7       ; IHS/SD/SDR - v2.6 p1 - HEAT414 - <UNDEF>EN+29^ABMPPFLR

 +8       ;IHS/SD/SDR - 2.6*19 - HEAT168248 - Removes payment multiple completely so residual entries from previous run don't mess up current transactions

 +9       ;

EN        ;EP

 +1        SET ABMSTAT=""

 +2       ; bill status x-ref

 +3        FOR 

               SET ABMSTAT=$ORDER(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),ABMSTAT))

               IF ABMSTAT=""

                   QUIT 

               Begin DoDot:1

 +4                IF ABMSTAT="X"

                       QUIT 

 +5                SET ABMBIEN=0

 +6                FOR 

                       SET ABMBIEN=$ORDER(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),ABMSTAT,ABMBIEN))

                       IF +ABMBIEN=0

                           QUIT 

                       Begin DoDot:2

 +7       ;active insurer

                           SET ABMAINS=$PIECE($GET(^ABMDBILL(DUZ(2),ABMBIEN,0)),U,8)

 +8       ;quit if no data for insurer

                           IF '$DATA(ABMPP(ABMAINS))

                               QUIT 

 +9       ;abm*2.6*19 HEAT168248

                           KILL ^ABMDBILL(DUZ(2),ABMBIEN,3)

 +10                       KILL ABMBPIEN

 +11                       SET ABMCAT=""

 +12                       FOR 

                               SET ABMCAT=$ORDER(ABMPP(ABMAINS,ABMCAT))

                               IF ABMCAT=""

                                   QUIT 

                               Begin DoDot:3

 +13                               SET ABMLN=0

 +14                               FOR 

                                       SET ABMLN=$ORDER(ABMPP(ABMAINS,ABMCAT,ABMLN))

                                       IF +ABMLN=0

                                           QUIT 

                                       Begin DoDot:4

 +15      ;amt

                                           SET ABMLAMT=$PIECE(ABMPP(ABMAINS,ABMCAT,ABMLN),U)

 +16                                       IF +ABMLAMT=0

                                               IF $PIECE($GET(ABMPP(ABMAINS,ABMCAT,ABMLN)),U,6)'=""

                                                   Begin DoDot:5

 +17                                                   SET DA(1)=ABMBIEN

 +18                                                   SET DIK="^ABMDBILL(DUZ(2),DA(1),3,"

 +19                                                   SET DA=$PIECE(ABMPP(ABMAINS,ABMCAT,ABMLN),U,6)

 +20                                                   DO ^DIK

                                                   End DoDot:5

                                                   QUIT 

 +21                                       IF +ABMLAMT=0

                                               QUIT 

 +22      ;adj category

                                           SET ABMADJC=$PIECE($GET(ABMPP(ABMAINS,ABMCAT,ABMLN)),U,2)

 +23      ;trans type

                                           SET ABMADJT=$PIECE($GET(ABMPP(ABMAINS,ABMCAT,ABMLN)),U,3)

 +24      ;std adj reason

                                           SET ABMSAR=$SELECT($PIECE($GET(ABMPP(ABMAINS,ABMCAT,ABMLN)),U,4)'="":$PIECE(ABMPP(ABMAINS,ABMCAT,ABMLN),U,4),1:"@")

 +25      ;S ABMBPIEN=$P($G(ABMPP(ABMAINS,ABMCAT,ABMLN)),U,6)  ;IEN of entry  ;abm*2.6*19 IHS/SD/SDR HEAT168248

 +26      ;treat like a new entry every time - was killed above, as well as entries could have been edited, merged  ;abm*2.6*19 IHS/SD/SDR HEAT168248

                                           SET ABMBPIEN=0

 +27      ;file as new entry

                                           IF +ABMBPIEN=0

                                               Begin DoDot:5

 +28                                               DO ^XBFMK

 +29                                               SET DA(1)=ABMBIEN

 +30      ;S X=ABMOPDT  ;abm*2.6*1 HEAT414

 +31      ;abm*2.6*1 HEAT414

                                                   SET X=$SELECT($GET(ABMOPDT)'="":ABMOPDT,1:DT)

 +32                                               SET DIC="^ABMDBILL(DUZ(2),"_DA(1)_",3,"

 +33                                               SET DIC(0)="LI"

 +34                                               SET DIC("P")=$PIECE(^DD(9002274.4,3,0),U,2)

 +35                                               KILL DD,DO

                                                   DO FILE^DICN

 +36                                               SET ABMBPIEN=+Y

 +37                                               SET $PIECE(ABMPP(ABMAINS,ABMCAT,ABMLN),U,6)=ABMBPIEN

                                               End DoDot:5

 +38                                       KILL X,Y,DIC,DIE,DR,DA

 +39                                       SET DA(1)=ABMBIEN

 +40                                       SET DIE="^ABMDBILL(DUZ(2),DA(1),3,"

 +41                                       SET DA=ABMBPIEN

 +42                                       IF ABMCAT="P"

                                               Begin DoDot:5

 +43                                               SET DR=".02///"_ABMLAMT_";.1///"_ABMLAMT

                                               End DoDot:5

 +44                                       IF ABMCAT="A"

                                               Begin DoDot:5

 +45                                               IF ABMADJC=3

                                                       SET DR=".06///"_ABMLAMT

 +46                                               IF ABMADJC=4

                                                       SET DR=".07///"_ABMLAMT

 +47                                               IF ABMADJC=13

                                                       SET DR=".03///"_ABMLAMT

 +48                                               IF ABMADJC=14

                                                       SET DR=".04///"_ABMLAMT

 +49                                               IF ABMADJC=15

                                                       SET DR=".09///"_ABMLAMT

 +50                                               IF ABMADJC=16

                                                       SET DR=".12///"_ABMLAMT

 +51                                               IF ABMADJC=19

                                                       SET DR=".13///"_ABMLAMT

 +52                                               IF ABMADJC=20

                                                       SET DR=".14///"_ABMLAMT

 +53                                               SET DR=$GET(DR)_";.15///"_ABMADJC_";.16///"_ABMADJT_";.17////"_ABMSAR

                                               End DoDot:5

 +54                                       DO ^DIE

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +55       SET ABMSPLFG=1

 +56       QUIT