ABPAPD3.m

ABPAPD3 ;AO PVT-INS PAYMENT ENTRY CONTINUED; [ 06/27/91  5:36 PM ]

 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

 W !,ABPAX

 W !,"Updating the bill records for: ",$P(^ABPVAO(ABPATDFN,0),"^")

 K DIC,DIE,DA,DR,ABPA("QF") S ABPADOS=ABPAFRDT-1

 F ABPA("I")=0:0 D  Q:$D(ABPA("QF",1))=1

 .S ABPADOS=$O(^ABPVAO("PC",ABPATDFN,ABPADOS))

 .I +ABPADOS=0!(ABPADOS>ABPATODT) S ABPA("QF",1)="" Q

 .K ABPA("QF",2) S ABPACDFN=0 F ABPA("II")=0:0 D  Q:$D(ABPA("QF",2))=1

 ..S ABPACDFN=$O(^ABPVAO("PC",ABPATDFN,ABPADOS,ABPACDFN))

 ..I +ABPACDFN=0 S ABPA("QF",2)="" Q

 ..Q:$D(^ABPVAO(ABPATDFN,1,ABPACDFN,0))=0

 ..S ABPAVTYP=$P(^ABPVAO(ABPATDFN,1,ABPACDFN,0),"^",17)

 ..Q:$D(ABPACSCR(+ABPACDFN))=1

 ..K DIE,DR,DA S DIE="^ABPVAO("_ABPATDFN_",1,"

 ..S DR=".18///"_"PA",DA(1)=ABPATDFN,DA=+ABPACDFN D ^DIE

 ..I $D(^ABPVAO(DA(1),"P",ABPADDFN,"D",0))=0 D

 ...S ^ABPVAO(DA(1),"P",ABPADDFN,"D",0)="^9002270.222DA^^0"

 ..K DIC,DIE,DR,DA S DA(1)=ABPADDFN,DA(2)=ABPATDFN

 ..S DIC="^ABPVAO("_DA(2)_",""P"","_DA(1)_",""D"",",DIC(0)="LZ"

 ..S X=$E(ABPADOS,4,7)_$E(ABPADOS,2,3) D ^DIC S DA=+Y

 ..I +$P(Y,"^",3)<1 D

 ...S X=""""_$E(ABPADOS,4,7)_$E(ABPADOS,2,3)_""""

 ...D ^DIC S DA=+Y

 ..S DIE=DIC,DR="1///"_ABPACDFN D ^DIE W "." Q

DISP K DIC,DIE,DA,DR,ABPA("QF"),ABPADOS,ABPA("I"),ABPA("II"),ABPACDFN

 K ABPAVTYP,ABPA("QF"),ABPAPTR,ABPADATA,ABPATYPE

 S U="^",DC=1,D0=ABPATDFN K DXS W @IOF,! D ^ABPAPDB K DXS,D0 W !

 S ABPA("I")="Current Payment Transactions" W ?(40-($L(ABPA("I"))/2))

 W ABPA("I"),!!,"TRN  DATE REC'D  PAID AMOUNT  CODE   CLAIM #    "

 W "CHECK NUMBER   DATE POSTED",!,"---  ----------  -----------  "

 W "----  --------  ---------------  -----------"

 G ^ABPAPD5

ABPAPD3   ;AO PVT-INS PAYMENT ENTRY CONTINUED; [ 06/27/91  5:36 PM ]

 +1       ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

 +2        WRITE !,ABPAX

 +3        WRITE !,"Updating the bill records for: ",$PIECE(^ABPVAO(ABPATDFN,0),"^")

 +4        KILL DIC,DIE,DA,DR,ABPA("QF")

           SET ABPADOS=ABPAFRDT-1

 +5        FOR ABPA("I")=0:0

               Begin DoDot:1

 +6                SET ABPADOS=$ORDER(^ABPVAO("PC",ABPATDFN,ABPADOS))

 +7                IF +ABPADOS=0!(ABPADOS>ABPATODT)

                       SET ABPA("QF",1)=""

                       QUIT 

 +8                KILL ABPA("QF",2)

                   SET ABPACDFN=0

                   FOR ABPA("II")=0:0

                       Begin DoDot:2

 +9                        SET ABPACDFN=$ORDER(^ABPVAO("PC",ABPATDFN,ABPADOS,ABPACDFN))

 +10                       IF +ABPACDFN=0

                               SET ABPA("QF",2)=""

                               QUIT 

 +11                       IF $DATA(^ABPVAO(ABPATDFN,1,ABPACDFN,0))=0

                               QUIT 

 +12                       SET ABPAVTYP=$PIECE(^ABPVAO(ABPATDFN,1,ABPACDFN,0),"^",17)

 +13                       IF $DATA(ABPACSCR(+ABPACDFN))=1

                               QUIT 

 +14                       KILL DIE,DR,DA

                           SET DIE="^ABPVAO("_ABPATDFN_",1,"

 +15                       SET DR=".18///"_"PA"

                           SET DA(1)=ABPATDFN

                           SET DA=+ABPACDFN

                           DO ^DIE

 +16                       IF $DATA(^ABPVAO(DA(1),"P",ABPADDFN,"D",0))=0

                               Begin DoDot:3

 +17                               SET ^ABPVAO(DA(1),"P",ABPADDFN,"D",0)="^9002270.222DA^^0"

                               End DoDot:3

 +18                       KILL DIC,DIE,DR,DA

                           SET DA(1)=ABPADDFN

                           SET DA(2)=ABPATDFN

 +19                       SET DIC="^ABPVAO("_DA(2)_",""P"","_DA(1)_",""D"","

                           SET DIC(0)="LZ"

 +20                       SET X=$EXTRACT(ABPADOS,4,7)_$EXTRACT(ABPADOS,2,3)

                           DO ^DIC

                           SET DA=+Y

 +21                       IF +$PIECE(Y,"^",3)<1

                               Begin DoDot:3

 +22                               SET X=""""_$EXTRACT(ABPADOS,4,7)_$EXTRACT(ABPADOS,2,3)_""""

 +23                               DO ^DIC

                                   SET DA=+Y

                               End DoDot:3

 +24                       SET DIE=DIC

                           SET DR="1///"_ABPACDFN

                           DO ^DIE

                           WRITE "."

                           QUIT 

                       End DoDot:2

                       IF $DATA(ABPA("QF",2))=1

                           QUIT 

               End DoDot:1

               IF $DATA(ABPA("QF",1))=1

                   QUIT 

DISP       KILL DIC,DIE,DA,DR,ABPA("QF"),ABPADOS,ABPA("I"),ABPA("II"),ABPACDFN

 +1        KILL ABPAVTYP,ABPA("QF"),ABPAPTR,ABPADATA,ABPATYPE

 +2        SET U="^"

           SET DC=1

           SET D0=ABPATDFN

           KILL DXS

           WRITE @IOF,!

           DO ^ABPAPDB

           KILL DXS,D0

           WRITE !

 +3        SET ABPA("I")="Current Payment Transactions"

           WRITE ?(40-($LENGTH(ABPA("I"))/2))

 +4        WRITE ABPA("I"),!!,"TRN  DATE REC'D  PAID AMOUNT  CODE   CLAIM #    "

 +5        WRITE "CHECK NUMBER   DATE POSTED",!,"---  ----------  -----------  "

 +6        WRITE "----  --------  ---------------  -----------"

 +7        GOTO ^ABPAPD5