ABPAPD1.m

ABPAPD1 ;PVT-INS PYMT ENTRY FROM END^ABPAPD3; [ 06/21/91  5:56 AM ]

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

BEG D XIT S U="^"

 S ABPA("HD",1)=ABPATLE,ABPA("HD",2)="Post PAYMENT Data"

 D ^ABPAHD W !,"*"

 S X="CURRENT BATCH FACILITY: "_$P(^DIC(4,ABPASITE,0),"^",1)

 W ?(40-($L(X)/2)),X,?78,"*",! F X=1:1:79 W "*"

 S X="BATCH DATE = "_ABPABDT W !!?(40-($L(X)/2)),X

PAT W !! D ^ABPAPATL

 I $D(ABPATDFN)'=1 D  G FAC^ABPAPD0

 .K ABPA("HD")

 .S ABPA("HD",1)=ABPATLE,ABPA("HD",2)="Post PAYMENT Data"

 .D ^ABPAHD S X="BATCH DATE = "_ABPABDT W !!?(40-($L(X)/2)),X

 G:+ABPATDFN<1 BEG

 L ^ABPVAO(ABPATDFN):3 I '$T D  G PAT

 .W *7,!!?5,"<<< PATIENT RECORD UNAVAILABLE AT THIS TIME -- "

 .W "TRY AGAIN LATER >>>"

HEAD S $P(ABPAX,"=",81)="",ABPAHRN=$P(^ABPVAO(ABPATDFN,0),"^",3)

 S ABPAL=$E($P(^DIC(4,$P(^ABPVAO(DA,0),U,2),0),U),1,19)

 S $P(ABPAXX,"-",81)="" ;,ABPAHD1="POST Payments" D HEADER^ABPAMAIN

 ;W !!,"Patient: ",ABPAPAT_"  ("_ABPAHRN_")",?50,"Facility: "

 ;W $E(ABPAL,1,19)

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

XIT K ABPARECV,ABPAPD,ABPAENT,ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D

 K ABPA,ABPAL,DIC,C,ABPAQKS,ABPAQK,ABPAHRN,DA,J,K,Z,XQH,ABPACOD

 K ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,%DT,ABPAFRDT,ABPATODT,ABPAX

 K ABPACSCR,ABPACHK,GOTCHECK,CLOSE,ABPACCNT,ABPACAMT,ABPAPAMT,ABPAPTOT

 K ABPATPD,ABPACOD,ABPACTOB,ABPACTPD,ABPACURB,ABPADATA,ABPADOS,ABPAJ

 K ABPAJ,ABPAK,ABPAOBAL,ABPAP1,ABPAP2,ABPAP3,ABPAP4,ABPAP5,ABPAPCOD

 K ABPAPOST,ABPAPSDT,ABPAPSSN,ABPAPTR,ABPAT1,ABPAT2,ABPAT3,ABPAT4

 K ABPAT5,ABPAT6,ABPATA2,ABPATA3,ABPATA4,ABPATA5,ABPATA7,ABPATBAL

 K ABPATCNT,ABPAY,ABPAZ,CLOSED,DIR,X Q

ABPAPD1   ;PVT-INS PYMT ENTRY FROM END^ABPAPD3; [ 06/21/91  5:56 AM ]

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

BEG        DO XIT

           SET U="^"

 +1        SET ABPA("HD",1)=ABPATLE

           SET ABPA("HD",2)="Post PAYMENT Data"

 +2        DO ^ABPAHD

           WRITE !,"*"

 +3        SET X="CURRENT BATCH FACILITY: "_$PIECE(^DIC(4,ABPASITE,0),"^",1)

 +4        WRITE ?(40-($LENGTH(X)/2)),X,?78,"*",!

           FOR X=1:1:79

               WRITE "*"

 +5        SET X="BATCH DATE = "_ABPABDT

           WRITE !!?(40-($LENGTH(X)/2)),X

PAT        WRITE !!

           DO ^ABPAPATL

 +1        IF $DATA(ABPATDFN)'=1

               Begin DoDot:1

 +2                KILL ABPA("HD")

 +3                SET ABPA("HD",1)=ABPATLE

                   SET ABPA("HD",2)="Post PAYMENT Data"

 +4                DO ^ABPAHD

                   SET X="BATCH DATE = "_ABPABDT

                   WRITE !!?(40-($LENGTH(X)/2)),X

               End DoDot:1

               GOTO FAC^ABPAPD0

 +5        IF +ABPATDFN<1

               GOTO BEG

 +6        LOCK ^ABPVAO(ABPATDFN):3

           IF '$TEST

               Begin DoDot:1

 +7                WRITE *7,!!?5,"<<< PATIENT RECORD UNAVAILABLE AT THIS TIME -- "

 +8                WRITE "TRY AGAIN LATER >>>"

               End DoDot:1

               GOTO PAT

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

           SET ABPAHRN=$PIECE(^ABPVAO(ABPATDFN,0),"^",3)

 +1        SET ABPAL=$EXTRACT($PIECE(^DIC(4,$PIECE(^ABPVAO(DA,0),U,2),0),U),1,19)

 +2       ;,ABPAHD1="POST Payments" D HEADER^ABPAMAIN

           SET $PIECE(ABPAXX,"-",81)=""

 +3       ;W !!,"Patient: ",ABPAPAT_"  ("_ABPAHRN_")",?50,"Facility: "

 +4       ;W $E(ABPAL,1,19)

 +5        KILL DXS

           SET U="^"

           SET DC=1

           SET D0=ABPATDFN

           WRITE @IOF,!

           DO ^ABPAPDB

           KILL DXS

           GOTO ^ABPAPD2

XIT        KILL ABPARECV,ABPAPD,ABPAENT,ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D

 +1        KILL ABPA,ABPAL,DIC,C,ABPAQKS,ABPAQK,ABPAHRN,DA,J,K,Z,XQH,ABPACOD

 +2        KILL ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,%DT,ABPAFRDT,ABPATODT,ABPAX

 +3        KILL ABPACSCR,ABPACHK,GOTCHECK,CLOSE,ABPACCNT,ABPACAMT,ABPAPAMT,ABPAPTOT

 +4        KILL ABPATPD,ABPACOD,ABPACTOB,ABPACTPD,ABPACURB,ABPADATA,ABPADOS,ABPAJ

 +5        KILL ABPAJ,ABPAK,ABPAOBAL,ABPAP1,ABPAP2,ABPAP3,ABPAP4,ABPAP5,ABPAPCOD

 +6        KILL ABPAPOST,ABPAPSDT,ABPAPSSN,ABPAPTR,ABPAT1,ABPAT2,ABPAT3,ABPAT4

 +7        KILL ABPAT5,ABPAT6,ABPATA2,ABPATA3,ABPATA4,ABPATA5,ABPATA7,ABPATBAL

 +8        KILL ABPATCNT,ABPAY,ABPAZ,CLOSED,DIR,X

           QUIT