BARPRF3A ; IHS/SD/LSL - REFUND COMMAND PROCESSING CONTINUED ; 05/07/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**4**;OCT 26, 2005
;
;** A/R posting program
; continuation of command processing
;
Q
; *********************************************************************
;
SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ;EP;BAR*1.8*4 DD 4.1.7.2
;HEAVILY MODIFIED SEE SETTMP0 BELOW FOR ORIGNIAL
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
.D CKNEG^BARPST4(BARBBAL,0,BARAMT)
Q:BARSTOP
I BARTYP="R" D Q:BARSTOP ;ADD REFUND TO ADJ FIELD, NOT PAYMENT
.S $P(^BARTMP($J,BARDA,BARLIN),U,7)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,7)+BARAMT
.S BARREF=BARREF+BARAMT
.S BARADJ=BARADJ+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
K BARFLG("BARWARN")
S BARSTOP=0
S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
I BARTYP="R" D Q:BARSTOP
.S $P(^BARTMP($J,BARDA,BARLIN),U,6)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,6)+BARAMT
.S BARREF=BARREF+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^BARPST2(BARPASS),EOP^BARUTL(2)
Q
; *********************************************************************
;
WARN(BARLVL) ;
W *7,!,"Warning - Posted amount exceeds the "_$S(BARLVL=1:"batch",BARLVL=2:"item",1:"location")_" balance."
S BARSTOP=1
D EOP^BARUTL(1)
Q
SURE ;
S BARSTOP=0
K DIR
S DIR(0)="Y"
S DIR("A")="ARE YOU SURE"
S DIR("B")="NO"
D ^DIR
K DIR
I Y'=1 S BARSTOP=1
Q
SETTMP1(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ;EP
K BARFLG("BARWARN")
S BARSTOP=0
S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
I BARTYP="R" D Q:BARSTOP
.S $P(^BARTMP($J,BARDA,BARLIN),U,6)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,6)+BARAMT
.S BARREF=BARREF+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
BARPRF3A ; IHS/SD/LSL - REFUND COMMAND PROCESSING CONTINUED ; 05/07/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4**;OCT 26, 2005
+2 ;
+3 ;** A/R posting program
+4 ; continuation of command processing
+5 ;
+6 QUIT
+7 ; *********************************************************************
+8 ;
SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ;EP;BAR*1.8*4 DD 4.1.7.2
+1 ;HEAVILY MODIFIED SEE SETTMP0 BELOW FOR ORIGNIAL
+2 KILL BARFLG("BARWARN")
+3 SET BARSTOP=0
+4 SET BARDA=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+5 SET BARBBAL=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)
+6 ;DON'T CHECK BALANCE FOR PENDING/GEN INFO
IF BARCAT'=21&(BARCAT'=22)
Begin DoDot:1
+7 DO CKNEG^BARPST4(BARBBAL,0,BARAMT)
End DoDot:1
+8 IF BARSTOP
QUIT
+9 ;ADD REFUND TO ADJ FIELD, NOT PAYMENT
IF BARTYP="R"
Begin DoDot:1
+10 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,7)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,7)+BARAMT
+11 SET BARREF=BARREF+BARAMT
+12 SET BARADJ=BARADJ+BARAMT
End DoDot:1
IF BARSTOP
QUIT
+13 IF BARTYP="A"
Begin DoDot:1
+14 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,7)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,7)+BARAMT
+15 SET BARADJ=BARADJ+BARAMT
End DoDot:1
+16 IF BARCAT'=21&(BARCAT'=22)
Begin DoDot:1
+17 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)-BARAMT
End DoDot:1
+18 SET BARJ=$ORDER(BARTR(BARLIN,""),-1)
+19 SET BARJ=BARJ+1
+20 SET BARTR(BARLIN,BARJ)=BARTYP_U_BARAMT_U_BARCAT_U_$GET(BARATYP)
+21 QUIT
+22 ; *********************************************************************
SETTMP0(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ;EP;ORIGINAL CODE ;BAR*1.8*4 DD 4.1.7.2
+1 KILL BARFLG("BARWARN")
+2 SET BARSTOP=0
+3 SET BARDA=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+4 IF BARTYP="R"
Begin DoDot:1
+5 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,6)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,6)+BARAMT
+6 SET BARREF=BARREF+BARAMT
End DoDot:1
IF BARSTOP
QUIT
+7 IF BARTYP="A"
Begin DoDot:1
+8 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,7)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,7)+BARAMT
+9 SET BARADJ=BARADJ+BARAMT
End DoDot:1
+10 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)-BARAMT
+11 SET BARJ=$ORDER(BARTR(BARLIN,""),-1)
+12 SET BARJ=BARJ+1
+13 SET BARTR(BARLIN,BARJ)=BARTYP_U_BARAMT_U_BARCAT_U_$GET(BARATYP)
+14 QUIT
+15 ;
+16 ;
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^BARPST2(BARPASS)
DO EOP^BARUTL(2)
+9 QUIT
+10 ; *********************************************************************
+11 ;
WARN(BARLVL) ;
+1 WRITE *7,!,"Warning - Posted amount exceeds the "_$SELECT(BARLVL=1:"batch",BARLVL=2:"item",1:"location")_" balance."
+2 SET BARSTOP=1
+3 DO EOP^BARUTL(1)
+4 QUIT
SURE ;
+1 SET BARSTOP=0
+2 KILL DIR
+3 SET DIR(0)="Y"
+4 SET DIR("A")="ARE YOU SURE"
+5 SET DIR("B")="NO"
+6 DO ^DIR
+7 KILL DIR
+8 IF Y'=1
SET BARSTOP=1
+9 QUIT
SETTMP1(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ;EP
+1 KILL BARFLG("BARWARN")
+2 SET BARSTOP=0
+3 SET BARDA=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+4 IF BARTYP="R"
Begin DoDot:1
+5 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,6)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,6)+BARAMT
+6 SET BARREF=BARREF+BARAMT
End DoDot:1
IF BARSTOP
QUIT
+7 IF BARTYP="A"
Begin DoDot:1
+8 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,7)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,7)+BARAMT
+9 SET BARADJ=BARADJ+BARAMT
End DoDot:1
+10 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)-BARAMT
+11 SET BARJ=$ORDER(BARTR(BARLIN,""),-1)
+12 SET BARJ=BARJ+1
+13 SET BARTR(BARLIN,BARJ)=BARTYP_U_BARAMT_U_BARCAT_U_$GET(BARATYP)
+14 QUIT
