ABMDUB.m

ABMDUB ; IHS/ASDST/DMJ - COMPUTE UNCOLLECTED BALANCE ;

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

START ;START HERE

 S DA(1)=0 F  S DA(1)=$O(^ABMDBILL(DUZ(2),DA(1))) Q:'DA(1)  D RC

 K ABM,ABMTOT Q

RC ;RECALCULATE UNOBLIGATED BALANCE FIELD FOR ONE BILL

 S ABM("BILLED")=+$P($G(^ABMDBILL(DUZ(2),DA(1),2)),U)

 F I=2,3,4,6 S ABMTOT(I)=0

 S DA=0 F  S DA=$O(^ABMDBILL(DUZ(2),DA(1),3,DA)) Q:'DA  D

 .F I=2,3,4,6 S ABM(I)=$P(^ABMDBILL(DUZ(2),DA(1),3,DA,0),"^",I),ABMTOT(I)=ABMTOT(I)+ABM(I)

 S ABM("UB")=ABM("BILLED")-ABMTOT(2)-ABMTOT(3)-ABMTOT(4)-ABMTOT(6)

 S ABM("UB")=$J(ABM("UB"),1,2)

 S DIE="^ABMDBILL(DUZ(2),",DA=DA(1),DR=".25////"_ABM("UB") D ^DIE

 Q

ABMDUB    ; IHS/ASDST/DMJ - COMPUTE UNCOLLECTED BALANCE ;

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

START     ;START HERE

 +1        SET DA(1)=0

           FOR 

               SET DA(1)=$ORDER(^ABMDBILL(DUZ(2),DA(1)))

               IF 'DA(1)

                   QUIT 

               DO RC

 +2        KILL ABM,ABMTOT

           QUIT 

RC        ;RECALCULATE UNOBLIGATED BALANCE FIELD FOR ONE BILL

 +1        SET ABM("BILLED")=+$PIECE($GET(^ABMDBILL(DUZ(2),DA(1),2)),U)

 +2        FOR I=2,3,4,6

               SET ABMTOT(I)=0

 +3        SET DA=0

           FOR 

               SET DA=$ORDER(^ABMDBILL(DUZ(2),DA(1),3,DA))

               IF 'DA

                   QUIT 

               Begin DoDot:1

 +4                FOR I=2,3,4,6

                       SET ABM(I)=$PIECE(^ABMDBILL(DUZ(2),DA(1),3,DA,0),"^",I)

                       SET ABMTOT(I)=ABMTOT(I)+ABM(I)

               End DoDot:1

 +5        SET ABM("UB")=ABM("BILLED")-ABMTOT(2)-ABMTOT(3)-ABMTOT(4)-ABMTOT(6)

 +6        SET ABM("UB")=$JUSTIFY(ABM("UB"),1,2)

 +7        SET DIE="^ABMDBILL(DUZ(2),"

           SET DA=DA(1)

           SET DR=".25////"_ABM("UB")

           DO ^DIE

 +8        QUIT