ABPABRC0.m

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