- 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
