- 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