ABPAPDD2.m

ABPAPDD2 ;DISPLAY PAYMENT TRANS. SCREEN.; [ 06/25/91  4:02 PM ]

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

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

A0 K ABPA("QF"),SA,ABPAPSDT,ABPARECV,ABPAPOST,ABPADATA,ABPA("CHK")

 S ABPAPAMT=0,ABPA("STDAMT")=0,ABPA("UP","N")=0,ABPA("UP","D")=0

 S ABPA("UP","S")=0,ABPARECV=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^")

 S ABPARECV=$E(ABPARECV,4,5)_"/"_$E(ABPARECV,6,7)_"/"_$E(ABPARECV,2,3)

 S ABPAPOST=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",3)

 S ABPAPOST=$S(ABPAPOST="N":"NO",ABPAPOST="Y":"YES",1:"???")

 S ABPADATA=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",2)

 I +ABPADATA>0 D

 .S ABPAPSDT=$E(ABPADATA,4,5)_"/"_$E(ABPADATA,6,7)_"/"

 .S ABPAPSDT=ABPAPSDT_$E(ABPADATA,2,3)

 S:$D(ABPAPSDT)=0 ABPAPSDT=""

 S ABPA("CHK")=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",6)

LOOP S DA=0 F ABPA("I")=0:0 D  Q:$D(ABPA("QF"))=1

 .S DA=$O(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA))

 .I +DA=0 S ABPA("QF")="" Q

 .Q:$D(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA,0))'=1  S ABPADATA=^(0)

 .W !,$J(DA,3),?7,ABPARECV S ABPAPCOD=$P(ABPADATA,"^",2)

 .S ABPACDFN=$P(ABPADATA,"^",3) W ?18,$J(+ABPADATA,9,2),?32,ABPAPCOD

 .I ABPACDFN]"" I $D(^ABPVAO(ABPATDFN,1,ABPACDFN,0))=1 D

 ..W ?36,$J($P(^ABPVAO(ABPATDFN,1,ABPACDFN,0),"^",2),8)

 ..S ABPA("AP",ABPACDFN,DA)=ABPADATA

 .I ABPACDFN']""&("NDS"[ABPAPCOD) D

 ..S ABPA("UP",ABPAPCOD)=ABPA("UP",ABPAPCOD)+(+ABPADATA)

 .I ABPAPCOD="S" W ?46,$J(ABPA("CHK"),15) D

 ..S ABPA("STDAMT")=ABPA("STDAMT")+(+ABPADATA)

 .W ?65,ABPAPSDT S ABPAPAMT=ABPAPAMT+(+ABPADATA)

ENDLOOP S $P(ABPAX,"=",81)="" W !,ABPAX

 K ABPAPOST,ABPAPSDT,ABPARECV,ABPA("QF"),ABPADATA,ABPA("I")

 S ABPACHK=ABPA("CHK") G ^ABPAPDD4

ABPAPDD2  ;DISPLAY PAYMENT TRANS. SCREEN.; [ 06/25/91  4:02 PM ]

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

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

A0         KILL ABPA("QF"),SA,ABPAPSDT,ABPARECV,ABPAPOST,ABPADATA,ABPA("CHK")

 +1        SET ABPAPAMT=0

           SET ABPA("STDAMT")=0

           SET ABPA("UP","N")=0

           SET ABPA("UP","D")=0

 +2        SET ABPA("UP","S")=0

           SET ABPARECV=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^")

 +3        SET ABPARECV=$EXTRACT(ABPARECV,4,5)_"/"_$EXTRACT(ABPARECV,6,7)_"/"_$EXTRACT(ABPARECV,2,3)

 +4        SET ABPAPOST=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",3)

 +5        SET ABPAPOST=$SELECT(ABPAPOST="N":"NO",ABPAPOST="Y":"YES",1:"???")

 +6        SET ABPADATA=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",2)

 +7        IF +ABPADATA>0

               Begin DoDot:1

 +8                SET ABPAPSDT=$EXTRACT(ABPADATA,4,5)_"/"_$EXTRACT(ABPADATA,6,7)_"/"

 +9                SET ABPAPSDT=ABPAPSDT_$EXTRACT(ABPADATA,2,3)

               End DoDot:1

 +10       IF $DATA(ABPAPSDT)=0

               SET ABPAPSDT=""

 +11       SET ABPA("CHK")=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,0),"^",6)

LOOP       SET DA=0

           FOR ABPA("I")=0:0

               Begin DoDot:1

 +1                SET DA=$ORDER(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA))

 +2                IF +DA=0

                       SET ABPA("QF")=""

                       QUIT 

 +3                IF $DATA(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",DA,0))'=1

                       QUIT 

                   SET ABPADATA=^(0)

 +4                WRITE !,$JUSTIFY(DA,3),?7,ABPARECV

                   SET ABPAPCOD=$PIECE(ABPADATA,"^",2)

 +5                SET ABPACDFN=$PIECE(ABPADATA,"^",3)

                   WRITE ?18,$JUSTIFY(+ABPADATA,9,2),?32,ABPAPCOD

 +6                IF ABPACDFN]""

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

                           Begin DoDot:2

 +7                            WRITE ?36,$JUSTIFY($PIECE(^ABPVAO(ABPATDFN,1,ABPACDFN,0),"^",2),8)

 +8                            SET ABPA("AP",ABPACDFN,DA)=ABPADATA

                           End DoDot:2

 +9                IF ABPACDFN']""&("NDS"[ABPAPCOD)

                       Begin DoDot:2

 +10                       SET ABPA("UP",ABPAPCOD)=ABPA("UP",ABPAPCOD)+(+ABPADATA)

                       End DoDot:2

 +11               IF ABPAPCOD="S"

                       WRITE ?46,$JUSTIFY(ABPA("CHK"),15)

                       Begin DoDot:2

 +12                       SET ABPA("STDAMT")=ABPA("STDAMT")+(+ABPADATA)

                       End DoDot:2

 +13               WRITE ?65,ABPAPSDT

                   SET ABPAPAMT=ABPAPAMT+(+ABPADATA)

               End DoDot:1

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

                   QUIT 

ENDLOOP    SET $PIECE(ABPAX,"=",81)=""

           WRITE !,ABPAX

 +1        KILL ABPAPOST,ABPAPSDT,ABPARECV,ABPA("QF"),ABPADATA,ABPA("I")

 +2        SET ABPACHK=ABPA("CHK")

           GOTO ^ABPAPDD4