ABPAGPB ;PVT-INS PAYMENT ENTRY (START); [ 03/10/91 4:22 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
BATDT K DIC,ABPABDT S DIC("A")="Select PAYMENT BATCH DATE: "
S DIC="^ABPAPBAT(",DIC(0)="AEQZ" W !! D ^DIC
I +Y<0 Q
I +$P(Y,U,3)>0 D
.S ^ABPAPBAT(+Y,0)=^ABPAPBAT(+Y,0)_"^0^0^0^O^"_DUZ_"^"_DT
.K DIK,DA S DIK="^ABPAPBAT(",DA=+Y D IX^DIK
I ABPAOPT(7)="Y" G OWN
MULTI S LBATDT=9999999-(+Y),LBATDT=$O(^ABPAPBAT("AD",DUZ,LBATDT))
K ERRFLG I +LBATDT>0 D
.S ABPABDFN=9999999-LBATDT
.I $D(^ABPAPBAT(ABPABDFN,0))=0 S ERRFLG=1 Q
.I $P(^ABPAPBAT(ABPABDFN,0),"^",5)'="C" S ERRFLG=2 Q
I $D(ERRFLG)=1 D Q
.I +ERRFLG=1 D
..W *7,!!?5,"<<< GLOBAL ERROR DETECTED - PLEASE CONTACT YOUR "
..W "SYSTEM MANAGER >>>" H 3
.I +ERRFLG=2 D
..W *7,!!?13,"<<< BATCH DATE *** ",+$E(ABPABDFN,4,5)_"/"
..W +$E(ABPABDFN,6,7)_"/"_+$E(ABPABDFN,2,3)," *** IS NOT CLOSED >>>"
..H 2 W !!?25,"NEW BATCH NOT ALLOWED" H 2
.I +$P(Y,"^",3)>0 I +$P(^ABPAPBAT(+Y,0),"^",6)=+DUZ D
..K DIK,DA S DIK="^ABPAPBAT(",DA=+Y D ^DIK
OWN I ABPAOPT(8)="Y" G OPEN
I $P(^ABPAPBAT(+Y,0),"^",6)'=DUZ D G BATDT
.W *7,!!?15,"<<< BATCH DOESN'T BELONG TO YOU -- CANNOT ACCESS >>>"
OPEN I $P(^ABPAPBAT(+Y,0),"^",5)="C" D G BATDT
.W *7,!!?15,"<<< BATCH CLOSED - NO CHANGES ALLOWED >>>"
LOCK L ^ABPAPBAT(+Y,0):3 I '$T D G BATDT
.W *7,!!?15,"<<< BATCH ALREADY IN USE - CANNOT ACCESS >>>"
SET S ABPABDT=+$E(+Y,4,5)_"/"_+$E(+Y,6,7)_"/"_+$E(+Y,2,3)
S ABPABDFN=+Y
Q
ABPAGPB ;PVT-INS PAYMENT ENTRY (START); [ 03/10/91 4:22 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
BATDT KILL DIC,ABPABDT
SET DIC("A")="Select PAYMENT BATCH DATE: "
+1 SET DIC="^ABPAPBAT("
SET DIC(0)="AEQZ"
WRITE !!
DO ^DIC
+2 IF +Y<0
QUIT
+3 IF +$PIECE(Y,U,3)>0
Begin DoDot:1
+4 SET ^ABPAPBAT(+Y,0)=^ABPAPBAT(+Y,0)_"^0^0^0^O^"_DUZ_"^"_DT
+5 KILL DIK,DA
SET DIK="^ABPAPBAT("
SET DA=+Y
DO IX^DIK
End DoDot:1
+6 IF ABPAOPT(7)="Y"
GOTO OWN
MULTI SET LBATDT=9999999-(+Y)
SET LBATDT=$ORDER(^ABPAPBAT("AD",DUZ,LBATDT))
+1 KILL ERRFLG
IF +LBATDT>0
Begin DoDot:1
+2 SET ABPABDFN=9999999-LBATDT
+3 IF $DATA(^ABPAPBAT(ABPABDFN,0))=0
SET ERRFLG=1
QUIT
+4 IF $PIECE(^ABPAPBAT(ABPABDFN,0),"^",5)'="C"
SET ERRFLG=2
QUIT
End DoDot:1
+5 IF $DATA(ERRFLG)=1
Begin DoDot:1
+6 IF +ERRFLG=1
Begin DoDot:2
+7 WRITE *7,!!?5,"<<< GLOBAL ERROR DETECTED - PLEASE CONTACT YOUR "
+8 WRITE "SYSTEM MANAGER >>>"
HANG 3
End DoDot:2
+9 IF +ERRFLG=2
Begin DoDot:2
+10 WRITE *7,!!?13,"<<< BATCH DATE *** ",+$EXTRACT(ABPABDFN,4,5)_"/"
+11 WRITE +$EXTRACT(ABPABDFN,6,7)_"/"_+$EXTRACT(ABPABDFN,2,3)," *** IS NOT CLOSED >>>"
+12 HANG 2
WRITE !!?25,"NEW BATCH NOT ALLOWED"
HANG 2
End DoDot:2
+13 IF +$PIECE(Y,"^",3)>0
IF +$PIECE(^ABPAPBAT(+Y,0),"^",6)=+DUZ
Begin DoDot:2
+14 KILL DIK,DA
SET DIK="^ABPAPBAT("
SET DA=+Y
DO ^DIK
End DoDot:2
End DoDot:1
QUIT
OWN IF ABPAOPT(8)="Y"
GOTO OPEN
+1 IF $PIECE(^ABPAPBAT(+Y,0),"^",6)'=DUZ
Begin DoDot:1
+2 WRITE *7,!!?15,"<<< BATCH DOESN'T BELONG TO YOU -- CANNOT ACCESS >>>"
End DoDot:1
GOTO BATDT
OPEN IF $PIECE(^ABPAPBAT(+Y,0),"^",5)="C"
Begin DoDot:1
+1 WRITE *7,!!?15,"<<< BATCH CLOSED - NO CHANGES ALLOWED >>>"
End DoDot:1
GOTO BATDT
LOCK LOCK ^ABPAPBAT(+Y,0):3
IF '$TEST
Begin DoDot:1
+1 WRITE *7,!!?15,"<<< BATCH ALREADY IN USE - CANNOT ACCESS >>>"
End DoDot:1
GOTO BATDT
SET SET ABPABDT=+$EXTRACT(+Y,4,5)_"/"_+$EXTRACT(+Y,6,7)_"/"_+$EXTRACT(+Y,2,3)
+1 SET ABPABDFN=+Y
+2 QUIT
