ABPAPDV0.m

ABPAPDV0 ;PVT-INS PAYMENT DISPLAY (START); [ 03/08/91  4:38 PM ]

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

 D XIT,CURRENT^%ZIS S U="^"

 S ABPA("HD",1)=ABPATLE,ABPA("HD",2)="DISPLAY existing payments"

 D ^ABPAHD

BATDT K DIC S DIC("A")="Select PAYMENT BATCH DATE: "

 S DIC="^ABPAPBAT(",DIC(0)="AEQZ" W !! D ^DIC

 I +Y<0 D XIT G END

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

 S ABPABDFN=+Y K ABPA("HD")

 S ABPA("HD",1)=ABPATLE,ABPA("HD",2)="DISPLAY existing payments"

 D ^ABPAHD W !!

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

FAC K DIC S DIC="^DIC(4,",DIC(0)="AEQZ",DIC("A")="Select BATCH FACILITY: "

 W !! D ^DIC I +Y<1 G ABPAPDV0

 S ABPASITE=+Y

CONT G ^ABPAPDV1

XIT K ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D,ABPAX,ABPAFRDT,ABPATODT

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

 K ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,ABPAPD,ABPABDT,ABPASITE,DIC,X,Y Q

END K ABPA("I"),ABPABDFN Q

ABPAPDV0  ;PVT-INS PAYMENT DISPLAY (START); [ 03/08/91  4:38 PM ]

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

 +2        DO XIT

           DO CURRENT^%ZIS

           SET U="^"

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

           SET ABPA("HD",2)="DISPLAY existing payments"

 +4        DO ^ABPAHD

BATDT      KILL DIC

           SET DIC("A")="Select PAYMENT BATCH DATE: "

 +1        SET DIC="^ABPAPBAT("

           SET DIC(0)="AEQZ"

           WRITE !!

           DO ^DIC

 +2        IF +Y<0

               DO XIT

               GOTO END

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

 +4        SET ABPABDFN=+Y

           KILL ABPA("HD")

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

           SET ABPA("HD",2)="DISPLAY existing payments"

 +6        DO ^ABPAHD

           WRITE !!

 +7        SET X="BATCH DATE = "_ABPABDT

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

FAC        KILL DIC

           SET DIC="^DIC(4,"

           SET DIC(0)="AEQZ"

           SET DIC("A")="Select BATCH FACILITY: "

 +1        WRITE !!

           DO ^DIC

           IF +Y<1

               GOTO ABPAPDV0

 +2        SET ABPASITE=+Y

CONT       GOTO ^ABPAPDV1

XIT        KILL ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D,ABPAX,ABPAFRDT,ABPATODT

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

 +2        KILL ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,ABPAPD,ABPABDT,ABPASITE,DIC,X,Y

           QUIT 

END        KILL ABPA("I"),ABPABDFN

           QUIT