ABME10.m

ABME10 ; IHS/DSD/DMJ - Medicare Electronic ; 

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;

 K ABMR S U="^",ABMP("XMIT")=0,ABMY("TOT")="0^0^0"

 S XMSUB=$S(ABMP("EXP")=10:"INPATIENT MEDICARE BILLS FROM ",1:"")_$P(^AUTTLOC(DUZ(2),0),U)

 S XMDUZ=DUZ

 D XMZ^XMA2 I XMZ<1 W !!,*7,"Unable to create mail message at this time.",! Q

 D R01

 K ABMR Q

R01 ;RECORD 01

 S $P(ABMR(1)," ",193)=""

 S $E(ABMR(1),1,2)="01"

 S ^XMB(3.9,XMZ,2,2,0)=ABMR(1)

 Q

BDFN S ABMY("N")=0 F  S ABMY("N")=$O(ABMY(ABMY("N"))) Q:'ABMY("N")  D

 .S ABMP("BDFN")=0 F  S ABMP("BDFN")=$O(ABMY(ABMY("N"),ABMP("BDFN"))) Q:'ABMP("BDFN")  D

 ..Q:'$D(^ABMDBILL(ABMP("BDFN"),0))

 ..D ENT

 ..S $P(ABMY("TOT"),U)=$P(ABMY("TOT"),U)+1

XMIT ..I ABMP("XMIT")=0 S ABM("XM")="" F  S ABM("XM")=$O(^ABMDTXST("B",DT,ABM("XM"))) Q:'ABM("XM")  D  Q:ABMP("XMIT")

 ...Q:'$D(^ABMDTXST(ABM("XM"),0))  Q:$P(^(0),U,2)'=ABMP("EXP")

 ...I $D(ABMY("TYP")),$P(^ABMDTXST(ABM("XM"),0),U,3)=ABMY("TYP") S ABMP("XMIT")=ABM("XM")

 ...I $D(ABMY("INS")),$P(^ABMDTXST(ABM("XM"),0),U,4)=ABMY("INS") S ABMP("XMIT")=ABM("XM")

 ..I '+ABMP("XMIT") S DIC="^ABMDTXST(",DIC(0)="L",X=DT,DIC("DR")=".02////1;.07////1;.08////1;"_$S($D(ABMY("TYP")):".03////"_ABMY("TYP"),$D(ABMY("INS")):".04////"_$P(ABMY("INS"),U),1:".03////A")_";.05////"_DUZ

 ..I  K DD,DO D FILE^DICN S ABMP("XMIT")=+Y

 ..S DIE="^ABMDBILL(",DA=ABMP("BDFN"),DR=".04////B;.16////A;.17////"_ABMP("XMIT") D ^ABMDDIE Q:$D(ABM("DIE-FAIL"))

 ..K ^ABMDBILL("AS",+^ABMDBILL(ABMP("BDFN"),0),"A",ABMP("BDFN"))

 ..S ABM=ABMP("BDFN"),ABM("L")=ABMP("XMIT") K ABMP S ABMP("XMIT")=ABM("L"),ABMP("BDFN")=ABM

 Q

 ;

ENT ;EP for setting up export array

 K ABMR

 Q

ABME10    ; IHS/DSD/DMJ - Medicare Electronic ; 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;

 +3        KILL ABMR

           SET U="^"

           SET ABMP("XMIT")=0

           SET ABMY("TOT")="0^0^0"

 +4        SET XMSUB=$SELECT(ABMP("EXP")=10:"INPATIENT MEDICARE BILLS FROM ",1:"")_$PIECE(^AUTTLOC(DUZ(2),0),U)

 +5        SET XMDUZ=DUZ

 +6        DO XMZ^XMA2

           IF XMZ<1

               WRITE !!,*7,"Unable to create mail message at this time.",!

               QUIT 

 +7        DO R01

 +8        KILL ABMR

           QUIT 

R01       ;RECORD 01

 +1        SET $PIECE(ABMR(1)," ",193)=""

 +2        SET $EXTRACT(ABMR(1),1,2)="01"

 +3        SET ^XMB(3.9,XMZ,2,2,0)=ABMR(1)

 +4        QUIT 

BDFN       SET ABMY("N")=0

           FOR 

               SET ABMY("N")=$ORDER(ABMY(ABMY("N")))

               IF 'ABMY("N")

                   QUIT 

               Begin DoDot:1

 +1                SET ABMP("BDFN")=0

                   FOR 

                       SET ABMP("BDFN")=$ORDER(ABMY(ABMY("N"),ABMP("BDFN")))

                       IF 'ABMP("BDFN")

                           QUIT 

                       Begin DoDot:2

 +2                        IF '$DATA(^ABMDBILL(ABMP("BDFN"),0))

                               QUIT 

 +3                        DO ENT

 +4                        SET $PIECE(ABMY("TOT"),U)=$PIECE(ABMY("TOT"),U)+1

XMIT                       IF ABMP("XMIT")=0

                               SET ABM("XM")=""

                               FOR 

                                   SET ABM("XM")=$ORDER(^ABMDTXST("B",DT,ABM("XM")))

                                   IF 'ABM("XM")

                                       QUIT 

                                   Begin DoDot:3

 +1                                    IF '$DATA(^ABMDTXST(ABM("XM"),0))

                                           QUIT 

                                       IF $PIECE(^(0),U,2)'=ABMP("EXP")

                                           QUIT 

 +2                                    IF $DATA(ABMY("TYP"))

                                           IF $PIECE(^ABMDTXST(ABM("XM"),0),U,3)=ABMY("TYP")

                                               SET ABMP("XMIT")=ABM("XM")

 +3                                    IF $DATA(ABMY("INS"))

                                           IF $PIECE(^ABMDTXST(ABM("XM"),0),U,4)=ABMY("INS")

                                               SET ABMP("XMIT")=ABM("XM")

                                   End DoDot:3

                                   IF ABMP("XMIT")

                                       QUIT 

 +4                        IF '+ABMP("XMIT")

                               SET DIC="^ABMDTXST("

                               SET DIC(0)="L"

                               SET X=DT

                               SET DIC("DR")=".02////1;.07////1;.08////1;"_$SELECT($DATA(ABMY("TYP")):".03////"_ABMY("TYP"),$DATA(ABMY("INS")):".04////"_$PIECE(ABMY("INS"),U),1:".03////A")_";.05////"_DUZ

 +5                       IF $TEST

                               KILL DD,DO

                               DO FILE^DICN

                               SET ABMP("XMIT")=+Y

 +6                        SET DIE="^ABMDBILL("

                           SET DA=ABMP("BDFN")

                           SET DR=".04////B;.16////A;.17////"_ABMP("XMIT")

                           DO ^ABMDDIE

                           IF $DATA(ABM("DIE-FAIL"))

                               QUIT 

 +7                        KILL ^ABMDBILL("AS",+^ABMDBILL(ABMP("BDFN"),0),"A",ABMP("BDFN"))

 +8                        SET ABM=ABMP("BDFN")

                           SET ABM("L")=ABMP("XMIT")

                           KILL ABMP

                           SET ABMP("XMIT")=ABM("L")

                           SET ABMP("BDFN")=ABM

                       End DoDot:2

               End DoDot:1

 +9        QUIT 

 +10      ;

ENT       ;EP for setting up export array

 +1        KILL ABMR

 +2        QUIT