BARPUC3A ; IHS/SD/LSL - UNALLOCATED COMMAND CONTINUED ; 07/16/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**4,6**;OCT 26, 2005
;
;** A/R posting program
; continuation of command processing
;
Q
;
SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ; EP; HEAVILY MODIFIED ;BAR*1.8*4 DD 4.1.7.2
;SEE SETTMPO BELOW FOR ORIGINAL CODE
; command processing continued
K BARFLG("BARWARN")
S BARSTOP=0
S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
S BARBBAL=$P(^BARTMP($J,BARDA,BARLIN),U,5)
I BARCAT'=21&(BARCAT'=22) D ;DON'T CHECK BALANCE FOR PENDING/GEN INFO
.N BARZZZZ S BARZZZZ=1 ;DON'T CHECK BATCH/ITEM/LOCATION BALANCES;MRS:BAR*1.8*6 DD 4.2.5
.D CKNEG^BARPST4(BARBBAL,0,BARAMT)
Q:BARSTOP
I BARTYP="P" D Q:BARSTOP
.S $P(^BARTMP($J,BARDA,BARLIN),U,6)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,6)+BARAMT
.S BARPMT=BARPMT+BARAMT
I BARTYP="A" D
.S $P(^BARTMP($J,BARDA,BARLIN),U,7)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,7)+BARAMT
.S BARADJ=BARADJ+BARAMT
I BARCAT'=21&(BARCAT'=22) D
.S $P(^BARTMP($J,BARDA,BARLIN),U,5)=$P(^BARTMP($J,BARDA,BARLIN),U,5)-BARAMT
S BARJ=$O(BARTR(BARLIN,""),-1)
S BARJ=BARJ+1
S BARTR(BARLIN,BARJ)=BARTYP_U_BARAMT_U_BARCAT_U_$G(BARATYP)
Q
SETTMP0(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ; EP; ORIGINAL CODE ;BAR*1.8*4 DD 4.1.7.2
; command processing continued
K BARFLG("BARWARN")
S BARSTOP=0
S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
I BARTYP="P" D Q:BARSTOP
.I (BARTX(2)-(BARPMT+BARAMT))<0 D WARN Q
.S $P(^BARTMP($J,BARDA,BARLIN),U,6)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,6)+BARAMT
.S BARPMT=BARPMT+BARAMT
I BARTYP="A" D
.S $P(^BARTMP($J,BARDA,BARLIN),U,7)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,7)+BARAMT
.S BARADJ=BARADJ+BARAMT
S $P(^BARTMP($J,BARDA,BARLIN),U,5)=$P(^BARTMP($J,BARDA,BARLIN),U,5)-BARAMT
S BARJ=$O(BARTR(BARLIN,""),-1)
S BARJ=BARJ+1
S BARTR(BARLIN,BARJ)=BARTYP_U_BARAMT_U_BARCAT_U_$G(BARATYP)
Q
; *********************************************************************
;
HELP ;
W $$EN^BARVDF("IOF"),!!
W "Select one of the following: ",!
W !?5,"P - Post transactions to A/R."
W !?5,"M - More transaction processing."
W !?5,"C - Cancel all transactions and start over."
W !!,"This is a required response - Please select one to proceed!"
D EOP^BARUTL(1)
D HIT1^BARPUC2(BARPASS),EOP^BARUTL(2)
Q
; *********************************************************************
;
WARN ;
W *7,!,"Warning - Posted amount exceeds the UNALLOCATED transaction amount!"
S BARSTOP=1
D EOP^BARUTL(1)
Q
BARPUC3A ; IHS/SD/LSL - UNALLOCATED COMMAND CONTINUED ; 07/16/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,6**;OCT 26, 2005
+2 ;
+3 ;** A/R posting program
+4 ; continuation of command processing
+5 ;
+6 QUIT
+7 ;
SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ; EP; HEAVILY MODIFIED ;BAR*1.8*4 DD 4.1.7.2
+1 ;SEE SETTMPO BELOW FOR ORIGINAL CODE
+2 ; command processing continued
+3 KILL BARFLG("BARWARN")
+4 SET BARSTOP=0
+5 SET BARDA=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+6 SET BARBBAL=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)
+7 ;DON'T CHECK BALANCE FOR PENDING/GEN INFO
IF BARCAT'=21&(BARCAT'=22)
Begin DoDot:1
+8 ;DON'T CHECK BATCH/ITEM/LOCATION BALANCES;MRS:BAR*1.8*6 DD 4.2.5
NEW BARZZZZ
SET BARZZZZ=1
+9 DO CKNEG^BARPST4(BARBBAL,0,BARAMT)
End DoDot:1
+10 IF BARSTOP
QUIT
+11 IF BARTYP="P"
Begin DoDot:1
+12 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,6)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,6)+BARAMT
+13 SET BARPMT=BARPMT+BARAMT
End DoDot:1
IF BARSTOP
QUIT
+14 IF BARTYP="A"
Begin DoDot:1
+15 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,7)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,7)+BARAMT
+16 SET BARADJ=BARADJ+BARAMT
End DoDot:1
+17 IF BARCAT'=21&(BARCAT'=22)
Begin DoDot:1
+18 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)-BARAMT
End DoDot:1
+19 SET BARJ=$ORDER(BARTR(BARLIN,""),-1)
+20 SET BARJ=BARJ+1
+21 SET BARTR(BARLIN,BARJ)=BARTYP_U_BARAMT_U_BARCAT_U_$GET(BARATYP)
+22 QUIT
SETTMP0(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ; EP; ORIGINAL CODE ;BAR*1.8*4 DD 4.1.7.2
+1 ; command processing continued
+2 KILL BARFLG("BARWARN")
+3 SET BARSTOP=0
+4 SET BARDA=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+5 IF BARTYP="P"
Begin DoDot:1
+6 IF (BARTX(2)-(BARPMT+BARAMT))<0
DO WARN
QUIT
+7 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,6)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,6)+BARAMT
+8 SET BARPMT=BARPMT+BARAMT
End DoDot:1
IF BARSTOP
QUIT
+9 IF BARTYP="A"
Begin DoDot:1
+10 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,7)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,7)+BARAMT
+11 SET BARADJ=BARADJ+BARAMT
End DoDot:1
+12 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)-BARAMT
+13 SET BARJ=$ORDER(BARTR(BARLIN,""),-1)
+14 SET BARJ=BARJ+1
+15 SET BARTR(BARLIN,BARJ)=BARTYP_U_BARAMT_U_BARCAT_U_$GET(BARATYP)
+16 QUIT
+17 ; *********************************************************************
+18 ;
HELP ;
+1 WRITE $$EN^BARVDF("IOF"),!!
+2 WRITE "Select one of the following: ",!
+3 WRITE !?5,"P - Post transactions to A/R."
+4 WRITE !?5,"M - More transaction processing."
+5 WRITE !?5,"C - Cancel all transactions and start over."
+6 WRITE !!,"This is a required response - Please select one to proceed!"
+7 DO EOP^BARUTL(1)
+8 DO HIT1^BARPUC2(BARPASS)
DO EOP^BARUTL(2)
+9 QUIT
+10 ; *********************************************************************
+11 ;
WARN ;
+1 WRITE *7,!,"Warning - Posted amount exceeds the UNALLOCATED transaction amount!"
+2 SET BARSTOP=1
+3 DO EOP^BARUTL(1)
+4 QUIT
