- ABPABRC0 ;AUTO PAYMENT BATCH RE-CALCULATION;[ 07/14/91 9:11 AM ]
- ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- ;PROCEDURE TO CALCULATE CURRENT PAYMENT CATEGORY AMOUNTS
- W !! D WAIT^DICD W !!,"Re-calculating the BATCH SUMMARIES"
- S (S,D,N,P,R,DA(2))=0,ABPABDT=+ABPABDFN F I=0:0 D Q:+DA(2)=0
- .S DA(2)=$O(^ABPVAO("BD",ABPABDT,DA(2))) Q:+DA(2)=0
- .S DA(1)=0 F I=0:0 D Q:+DA(1)=0
- ..S DA(1)=$O(^ABPVAO("BD",ABPABDT,DA(2),DA(1))) Q:+DA(1)=0
- ..Q:$D(^ABPVAO(DA(2),"P",DA(1),0))'=1
- ..S ABPACHK("NUM")=$P(^(0),"^",6)
- ..S DA=0 F I=0:0 D Q:+DA=0
- ...S DA=$O(^ABPVAO(DA(2),"P",DA(1),"A",DA)) Q:+DA=0
- ...Q:$D(^ABPVAO(DA(2),"P",DA(1),"A",DA,0))'=1
- ...I +$P(^(0),"^")<0 I ABPACHK("NUM")']"" D Q
- ....S R=R+(+^ABPVAO(DA(2),"P",DA(1),"A",DA,0)*-1)
- ...S ABPATYP=$P(^(0),"^",2) Q:ABPATYP']"" Q:"SNDP"'[ABPATYP
- ...Q:ABPATYP="S"&(+^(0)>0)&(ABPACHK("NUM")']"")
- ...S @ABPATYP=@ABPATYP+(+^(0)) W "."
- S $P(^ABPAPBAT(ABPABDFN,0),"^",2)=+S
- S $P(^ABPAPBAT(ABPABDFN,0),"^",4)=+N
- S $P(^ABPAPBAT(ABPABDFN,0),"^",3)=+D
- S $P(^ABPAPBAT(ABPABDFN,0),"^",11)=+P
- S $P(^ABPAPBAT(ABPABDFN,0),"^",14)=+R
- K DIC,X,Y,S,D,N,DA,I,P,R,ABPABDT,ABPATYP,ABPACHK("NUM")
- Q
- CLOSE ;ENTRY POINT
- ;PROCEDURE TO CHECK BALANCE OF THE PAYMENT BATCH
- K P F ABPAJ=2,10,12,13 S P(ABPAJ)=$P(^ABPAPBAT(ABPABDFN,0),"^",ABPAJ)
- I ((P(10)+P(13))-(P(12)+P(2)))=0 D
- .W !,"The current balance of this batch is $ 0.00"
- .K DIR S DIR(0)="Y",DIR("A")="DO YOU WANT TO CLOSE THIS BATCH"
- .S DIR("B")="YES" W *7 D ^DIR I Y D W " ... Batch Closed!" Q
- ..S $P(^ABPAPBAT(ABPABDFN,0),"^",5)="C"
- ..S $P(^ABPAPBAT(ABPABDFN,0),"^",8)=DT
- ..S ^ABPAPBAT("AC",DT,ABPABDFN)=""
- ..S $P(^ABPAPBAT(ABPABDFN,0),"^",9)=DUZ
- .W " ... Not Closed!"
- ABPABRC0 ;AUTO PAYMENT BATCH RE-CALCULATION;[ 07/14/91 9:11 AM ]
- +1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- +2 ;PROCEDURE TO CALCULATE CURRENT PAYMENT CATEGORY AMOUNTS
- +3 WRITE !!
- DO WAIT^DICD
- WRITE !!,"Re-calculating the BATCH SUMMARIES"
- +4 SET (S,D,N,P,R,DA(2))=0
- SET ABPABDT=+ABPABDFN
- FOR I=0:0
- Begin DoDot:1
- +5 SET DA(2)=$ORDER(^ABPVAO("BD",ABPABDT,DA(2)))
- IF +DA(2)=0
- QUIT
- +6 SET DA(1)=0
- FOR I=0:0
- Begin DoDot:2
- +7 SET DA(1)=$ORDER(^ABPVAO("BD",ABPABDT,DA(2),DA(1)))
- IF +DA(1)=0
- QUIT
- +8 IF $DATA(^ABPVAO(DA(2),"P",DA(1),0))'=1
- QUIT
- +9 SET ABPACHK("NUM")=$PIECE(^(0),"^",6)
- +10 SET DA=0
- FOR I=0:0
- Begin DoDot:3
- +11 SET DA=$ORDER(^ABPVAO(DA(2),"P",DA(1),"A",DA))
- IF +DA=0
- QUIT
- +12 IF $DATA(^ABPVAO(DA(2),"P",DA(1),"A",DA,0))'=1
- QUIT
- +13 IF +$PIECE(^(0),"^")<0
- IF ABPACHK("NUM")']""
- Begin DoDot:4
- +14 SET R=R+(+^ABPVAO(DA(2),"P",DA(1),"A",DA,0)*-1)
- End DoDot:4
- QUIT
- +15 SET ABPATYP=$PIECE(^(0),"^",2)
- IF ABPATYP']""
- QUIT
- IF "SNDP"'[ABPATYP
- QUIT
- +16 IF ABPATYP="S"&(+^(0)>0)&(ABPACHK("NUM")']"")
- QUIT
- +17 SET @ABPATYP=@ABPATYP+(+^(0))
- WRITE "."
- End DoDot:3
- IF +DA=0
- QUIT
- End DoDot:2
- IF +DA(1)=0
- QUIT
- End DoDot:1
- IF +DA(2)=0
- QUIT
- +18 SET $PIECE(^ABPAPBAT(ABPABDFN,0),"^",2)=+S
- +19 SET $PIECE(^ABPAPBAT(ABPABDFN,0),"^",4)=+N
- +20 SET $PIECE(^ABPAPBAT(ABPABDFN,0),"^",3)=+D
- +21 SET $PIECE(^ABPAPBAT(ABPABDFN,0),"^",11)=+P
- +22 SET $PIECE(^ABPAPBAT(ABPABDFN,0),"^",14)=+R
- +23 KILL DIC,X,Y,S,D,N,DA,I,P,R,ABPABDT,ABPATYP,ABPACHK("NUM")
- +24 QUIT
- CLOSE ;ENTRY POINT
- +1 ;PROCEDURE TO CHECK BALANCE OF THE PAYMENT BATCH
- +2 KILL P
- FOR ABPAJ=2,10,12,13
- SET P(ABPAJ)=$PIECE(^ABPAPBAT(ABPABDFN,0),"^",ABPAJ)
- +3 IF ((P(10)+P(13))-(P(12)+P(2)))=0
- Begin DoDot:1
- +4 WRITE !,"The current balance of this batch is $ 0.00"
- +5 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="DO YOU WANT TO CLOSE THIS BATCH"
- +6 SET DIR("B")="YES"
- WRITE *7
- DO ^DIR
- IF Y
- Begin DoDot:2
- +7 SET $PIECE(^ABPAPBAT(ABPABDFN,0),"^",5)="C"
- +8 SET $PIECE(^ABPAPBAT(ABPABDFN,0),"^",8)=DT
- +9 SET ^ABPAPBAT("AC",DT,ABPABDFN)=""
- +10 SET $PIECE(^ABPAPBAT(ABPABDFN,0),"^",9)=DUZ
- End DoDot:2
- WRITE " ... Batch Closed!"
- QUIT
- +11 WRITE " ... Not Closed!"
- End DoDot:1
