Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARPUC3A

BARPUC3A.m

Go to the documentation of this file.
  1. BARPUC3A ; IHS/SD/LSL - UNALLOCATED COMMAND CONTINUED ; 07/16/2008
  1. ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,6**;OCT 26, 2005
  1. ;
  1. ;** A/R posting program
  1. ; continuation of command processing
  1. ;
  1. Q
  1. ;
  1. 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
  1. ; command processing continued
  1. K BARFLG("BARWARN")
  1. S BARSTOP=0
  1. S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
  1. S BARBBAL=$P(^BARTMP($J,BARDA,BARLIN),U,5)
  1. I BARCAT'=21&(BARCAT'=22) D ;DON'T CHECK BALANCE FOR PENDING/GEN INFO
  1. .N BARZZZZ S BARZZZZ=1 ;DON'T CHECK BATCH/ITEM/LOCATION BALANCES;MRS:BAR*1.8*6 DD 4.2.5
  1. .D CKNEG^BARPST4(BARBBAL,0,BARAMT)
  1. Q:BARSTOP
  1. I BARTYP="P" D Q:BARSTOP
  1. .S $P(^BARTMP($J,BARDA,BARLIN),U,6)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,6)+BARAMT
  1. .S BARPMT=BARPMT+BARAMT
  1. I BARTYP="A" D
  1. .S $P(^BARTMP($J,BARDA,BARLIN),U,7)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,7)+BARAMT
  1. .S BARADJ=BARADJ+BARAMT
  1. I BARCAT'=21&(BARCAT'=22) D
  1. .S $P(^BARTMP($J,BARDA,BARLIN),U,5)=$P(^BARTMP($J,BARDA,BARLIN),U,5)-BARAMT
  1. S BARJ=$O(BARTR(BARLIN,""),-1)
  1. S BARJ=BARJ+1
  1. S BARTR(BARLIN,BARJ)=BARTYP_U_BARAMT_U_BARCAT_U_$G(BARATYP)
  1. Q
  1. SETTMP0(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ; EP; ORIGINAL CODE ;BAR*1.8*4 DD 4.1.7.2
  1. ; command processing continued
  1. K BARFLG("BARWARN")
  1. S BARSTOP=0
  1. S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
  1. I BARTYP="P" D Q:BARSTOP
  1. .I (BARTX(2)-(BARPMT+BARAMT))<0 D WARN Q
  1. .S $P(^BARTMP($J,BARDA,BARLIN),U,6)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,6)+BARAMT
  1. .S BARPMT=BARPMT+BARAMT
  1. I BARTYP="A" D
  1. .S $P(^BARTMP($J,BARDA,BARLIN),U,7)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,7)+BARAMT
  1. .S BARADJ=BARADJ+BARAMT
  1. S $P(^BARTMP($J,BARDA,BARLIN),U,5)=$P(^BARTMP($J,BARDA,BARLIN),U,5)-BARAMT
  1. S BARJ=$O(BARTR(BARLIN,""),-1)
  1. S BARJ=BARJ+1
  1. S BARTR(BARLIN,BARJ)=BARTYP_U_BARAMT_U_BARCAT_U_$G(BARATYP)
  1. Q
  1. ; *********************************************************************
  1. ;
  1. HELP ;
  1. W $$EN^BARVDF("IOF"),!!
  1. W "Select one of the following: ",!
  1. W !?5,"P - Post transactions to A/R."
  1. W !?5,"M - More transaction processing."
  1. W !?5,"C - Cancel all transactions and start over."
  1. W !!,"This is a required response - Please select one to proceed!"
  1. D EOP^BARUTL(1)
  1. D HIT1^BARPUC2(BARPASS),EOP^BARUTL(2)
  1. Q
  1. ; *********************************************************************
  1. ;
  1. WARN ;
  1. W *7,!,"Warning - Posted amount exceeds the UNALLOCATED transaction amount!"
  1. S BARSTOP=1
  1. D EOP^BARUTL(1)
  1. Q