- ABPABCL ;CLOSE PAYMENT BATCH [ 05/06/91 11:47 AM ]
- ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- A0 D CURRENT^%ZIS,^%AUCLS W !!
- K ABPA("HD") S ABPA("HD",1)=ABPATLE
- S ABPA("HD",2)="CLOSE Payment Batch(es)" D ^ABPAHD
- BATDT K DIC S DIC("A")="Select PAYMENT BATCH DATE: "
- S DIC="^ABPAPBAT(",DIC(0)="AEQZ" W !! D ^DIC I +Y<0 G END
- OPEN I $P(^ABPAPBAT(+Y,0),U,5)="C" D G BATDT
- .W *7,!!?15,"<<< BATCH ALREADY CLOSED - CANNOT ACCESS >>>"
- LOCK L ^ABPAPBAT(+Y,0):3 I '$T D G BATDT
- .W *7,!!?15,"<<< BATCH IN USE - CANNOT ACCESS >>>"
- S ABPABDFN=+Y K ABPA("HD") S ABPA("HD",1)=ABPATLE
- S ABPA("HD",2)="CLOSE Payment Batch(es)" D ^ABPAHD
- S D0=ABPABDFN W !! K DXS D ^ABPABAT K DXS
- W ! S DX=0,DY=19 X XY W ! S $P(ABPALINE,"=",78)="" W ABPALINE
- YN K DIC,DIE,DA,DR,X,Y,%,ABPALINE
- W !,"IS THIS THE CORRECT BATCH" S %=1 D YN^DICN
- I +%<1 D G YN
- .W *7,!?4,"ENTER 'YES' OR 'NO'"
- NO I +%>1 D G A0
- .L ^ABPAPBAT(ABPABDFN,0) K DIC,DIE,DA,DR,X,Y,D0,%,ABPABDFN
- YES W !!,"Closing batch date *** ",+$E(ABPABDFN,4,5)_"/"_+$E(ABPABDFN,6,7)
- W "/"_+$E(ABPABDFN,2,3)," ***" H 2
- K DIC,DIE,DA,DR,X,Y S DIE="^ABPAPBAT(",DA=ABPABDFN
- S DR="5///C;8///"_DT_";9///"_DUZ D ^DIE
- L ^ABPAPBAT(ABPABDFN,0) D G A0
- .K DIC,DIE,DA,DR,X,Y,%,ABPABDFN
- END K DIC,DIE,DA,DR,X,Y,%,ABPABDFN
- ABPABCL ;CLOSE PAYMENT BATCH [ 05/06/91 11:47 AM ]
- +1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- A0 DO CURRENT^%ZIS
- DO ^%AUCLS
- WRITE !!
- +1 KILL ABPA("HD")
- SET ABPA("HD",1)=ABPATLE
- +2 SET ABPA("HD",2)="CLOSE Payment Batch(es)"
- DO ^ABPAHD
- BATDT KILL DIC
- SET DIC("A")="Select PAYMENT BATCH DATE: "
- +1 SET DIC="^ABPAPBAT("
- SET DIC(0)="AEQZ"
- WRITE !!
- DO ^DIC
- IF +Y<0
- GOTO END
- OPEN IF $PIECE(^ABPAPBAT(+Y,0),U,5)="C"
- Begin DoDot:1
- +1 WRITE *7,!!?15,"<<< BATCH ALREADY CLOSED - CANNOT ACCESS >>>"
- End DoDot:1
- GOTO BATDT
- LOCK LOCK ^ABPAPBAT(+Y,0):3
- IF '$TEST
- Begin DoDot:1
- +1 WRITE *7,!!?15,"<<< BATCH IN USE - CANNOT ACCESS >>>"
- End DoDot:1
- GOTO BATDT
- +2 SET ABPABDFN=+Y
- KILL ABPA("HD")
- SET ABPA("HD",1)=ABPATLE
- +3 SET ABPA("HD",2)="CLOSE Payment Batch(es)"
- DO ^ABPAHD
- +4 SET D0=ABPABDFN
- WRITE !!
- KILL DXS
- DO ^ABPABAT
- KILL DXS
- +5 WRITE !
- SET DX=0
- SET DY=19
- XECUTE XY
- WRITE !
- SET $PIECE(ABPALINE,"=",78)=""
- WRITE ABPALINE
- YN KILL DIC,DIE,DA,DR,X,Y,%,ABPALINE
- +1 WRITE !,"IS THIS THE CORRECT BATCH"
- SET %=1
- DO YN^DICN
- +2 IF +%<1
- Begin DoDot:1
- +3 WRITE *7,!?4,"ENTER 'YES' OR 'NO'"
- End DoDot:1
- GOTO YN
- NO IF +%>1
- Begin DoDot:1
- +1 LOCK ^ABPAPBAT(ABPABDFN,0)
- KILL DIC,DIE,DA,DR,X,Y,D0,%,ABPABDFN
- End DoDot:1
- GOTO A0
- YES WRITE !!,"Closing batch date *** ",+$EXTRACT(ABPABDFN,4,5)_"/"_+$EXTRACT(ABPABDFN,6,7)
- +1 WRITE "/"_+$EXTRACT(ABPABDFN,2,3)," ***"
- HANG 2
- +2 KILL DIC,DIE,DA,DR,X,Y
- SET DIE="^ABPAPBAT("
- SET DA=ABPABDFN
- +3 SET DR="5///C;8///"_DT_";9///"_DUZ
- DO ^DIE
- +4 LOCK ^ABPAPBAT(ABPABDFN,0)
- Begin DoDot:1
- +5 KILL DIC,DIE,DA,DR,X,Y,%,ABPABDFN
- End DoDot:1
- GOTO A0
- END KILL DIC,DIE,DA,DR,X,Y,%,ABPABDFN
