- ABPAPDD0 ;PVT-INS PAYMENT DELETE (START); [ 06/26/91 8:12 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)="DELETE existing payments"
- D ^ABPAHD
- BATDT D ^ABPAGPB I $D(ABPABDT)'=1 D XIT G END
- K ABPA("HD")
- S ABPA("HD",1)=ABPATLE,ABPA("HD",2)="DELETE existing payments"
- D ^ABPAHD W !!
- S D0=ABPABDFN K DXS D ^ABPABAT K DXS
- FAC K DIC S DIC="^DIC(4,",DIC(0)="AEQZ",DIC("A")="Select BATCH FACILITY: "
- W !! D ^DIC I +Y<1 D G ABPAPDD0
- .D ^ABPABRC0,XIT S U="^"
- .S ABPA("HD",1)=ABPATLE_" - DELETE existing payments"
- .S ABPA("HD",2)="BATCH SUMMARY" D ^ABPAHD W !!
- .S D0=ABPABDFN K DXS D ^ABPABAT K DXS
- .W ! F X=1:1:79 W "="
- .D CLOSE^ABPABRC0,PAUSE^ABPAMAIN
- .L
- S ABPASITE=+Y
- CONT G ^ABPAPDD1
- 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
- ABPAPDD0 ;PVT-INS PAYMENT DELETE (START); [ 06/26/91 8:12 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)="DELETE existing payments"
- +4 DO ^ABPAHD
- BATDT DO ^ABPAGPB
- IF $DATA(ABPABDT)'=1
- DO XIT
- GOTO END
- +1 KILL ABPA("HD")
- +2 SET ABPA("HD",1)=ABPATLE
- SET ABPA("HD",2)="DELETE existing payments"
- +3 DO ^ABPAHD
- WRITE !!
- +4 SET D0=ABPABDFN
- KILL DXS
- DO ^ABPABAT
- KILL DXS
- FAC KILL DIC
- SET DIC="^DIC(4,"
- SET DIC(0)="AEQZ"
- SET DIC("A")="Select BATCH FACILITY: "
- +1 WRITE !!
- DO ^DIC
- IF +Y<1
- Begin DoDot:1
- +2 DO ^ABPABRC0
- DO XIT
- SET U="^"
- +3 SET ABPA("HD",1)=ABPATLE_" - DELETE existing payments"
- +4 SET ABPA("HD",2)="BATCH SUMMARY"
- DO ^ABPAHD
- WRITE !!
- +5 SET D0=ABPABDFN
- KILL DXS
- DO ^ABPABAT
- KILL DXS
- +6 WRITE !
- FOR X=1:1:79
- WRITE "="
- +7 DO CLOSE^ABPABRC0
- DO PAUSE^ABPAMAIN
- +8 LOCK
- End DoDot:1
- GOTO ABPAPDD0
- +9 SET ABPASITE=+Y
- CONT GOTO ^ABPAPDD1
- 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
