BARPST3A ; IHS/SD/LSL - PAYMENT COMMAND CNT. ; 05/07/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,23**;OCT 26, 2005
;** A/R posting program
; continuation of command processing
;
; IHS/SD/LSL - 09/23/02 - V1.6 Patch 3 - HIPAA
; Don't allow PENDING category to affect balance
;
; ********************************************************************
Q
;
SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP,BAROAMT) ;EP - store & check amounts; HEAVILY MODIFIED;BAR*1.8*4 DD 4.1.7.2
;SEE SETTMPO BELOW FOR ORIGINAL CODE
K BARFLG("BARWARN")
S BARSTOP=0
S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
Q:BARDA=""
; -------------------------------
B1 ;
S BARBBAL=$P(^BARTMP($J,BARDA,BARLIN),U,5)
I BARCAT'=21&(BARCAT'=22) D
.S BARBBAL=BARBBAL+BAROAMT
.D CKNEG^BARPST4(BARBBAL,BAROAMT,BARAMT) ;CHECK FOR NEGATIVE BALANCES
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 Q:BARSTOP
.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 ;IF PENDING DON'T CHANGE BALANCE
.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)_U_$G(REVERSAL)_U_$G(REVSCHED) ;IHS/SD/TPF BAR*1.8*4 UFMS SCR56,SCR58
K BAROAMT,BARBBAL
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,BARDIF) ;EP - warner
I BARLVL=4,'$$IHS^BARUFUT(DUZ(2)) K BARFLG("BARWARN") Q ;BAR*1.8*4 DD 4.1.7.2 P.OTT
;;;I BARLVL=4,'$$IHSERA^BARUFUT(DUZ(2)) K BARFLG("BARWARN") Q ;BAR*1.8*4 DD 4.1.7.2 P.OTT
I '$G(BARFLG("BARWARN")) W !
W *7,!,"Warning - Posted amount exceeds the "
W $S(BARLVL=1:"BATCH",BARLVL=2:"ITEM",BARLVL=3:"LOCATION",1:"BILL")_" balance" ;BAR*1.8*4 DD 4.1.7.2
W " by "_BARDIF_" amount" ;BAR*1.8*4 DD 4.1.7.2
S BARFLG("BARWARN")=1
Q
;
; *********************************************************************
SETTMPO(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP,BAROAMT) ;EP - store & check amounts;ORIGINAL CODE;BAR*1.8*4
K BARFLG("BARWARN")
S BARSTOP=0
S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
Q:BARDA=""
; -------------------------------
B1O ;
S BARBBAL=$P(^BARTMP($J,BARDA,BARLIN),U,5) ;BAR*1.8*4 DD 4.1.7.2
I BARTYP="P" D Q:BARSTOP
.I (BARBBAL-BARAMT)<0 D WARN(4,(BARBBAL-BARAMT)) ;BAR*1.8*4 SDD 4.1.7.2
.I +$G(BAREOB),(BAREOV(4)-(BARPMT+BARAMT))<0 D WARN(3,(BAREOV(4)-(BARPMT+BARAMT)))
.I (BARITV(19)-(BARPMT+BARAMT))<0 D WARN(2,(BARITV(19)-(BARPMT+BARAMT)))
.I (BARCLV(17)-(BARPMT+BARAMT))<0 D WARN(1,(BARCLV(17)-(BARPMT+BARAMT)))
.I $G(BARFLG("BARWARN")) D Q:BARSTOP
..K BARFLG("BARWARN")
..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
.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 Q:BARSTOP
.I (BARBBAL-BARAMT)<0 D WARN(4,(BARBBAL-BARAMT)) ;BAR*1.8*4 SDD 4.1.7.2
.S $P(^BARTMP($J,BARDA,BARLIN),U,7)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,7)+BARAMT
.S BARADJ=BARADJ+BARAMT
S:BARCAT'=21 $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)_U_$G(REVERSAL)_U_$G(REVSCHED) ;IHS/SD/TPF BAR*1.8*4 UFMS SCR56,SCR58
Q
; *********************************************************************
BARPST3A ; IHS/SD/LSL - PAYMENT COMMAND CNT. ; 05/07/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,23**;OCT 26, 2005
+2 ;** A/R posting program
+3 ; continuation of command processing
+4 ;
+5 ; IHS/SD/LSL - 09/23/02 - V1.6 Patch 3 - HIPAA
+6 ; Don't allow PENDING category to affect balance
+7 ;
+8 ; ********************************************************************
+9 QUIT
+10 ;
SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP,BAROAMT) ;EP - store & check amounts; HEAVILY MODIFIED;BAR*1.8*4 DD 4.1.7.2
+1 ;SEE SETTMPO BELOW FOR ORIGINAL CODE
+2 KILL BARFLG("BARWARN")
+3 SET BARSTOP=0
+4 SET BARDA=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+5 IF BARDA=""
QUIT
+6 ; -------------------------------
B1 ;
+1 SET BARBBAL=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)
+2 IF BARCAT'=21&(BARCAT'=22)
Begin DoDot:1
+3 SET BARBBAL=BARBBAL+BAROAMT
+4 ;CHECK FOR NEGATIVE BALANCES
DO CKNEG^BARPST4(BARBBAL,BAROAMT,BARAMT)
End DoDot:1
+5 IF BARSTOP
QUIT
+6 IF BARTYP="P"
Begin DoDot:1
+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
IF BARSTOP
QUIT
+12 ;IF PENDING DON'T CHANGE BALANCE
IF BARCAT'=21&(BARCAT'=22)
Begin DoDot:1
+13 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)-BARAMT
End DoDot:1
+14 SET BARJ=$ORDER(BARTR(BARLIN,""),-1)
+15 SET BARJ=BARJ+1
+16 ;IHS/SD/TPF BAR*1.8*4 UFMS SCR56,SCR58
SET BARTR(BARLIN,BARJ)=BARTYP_U_BARAMT_U_BARCAT_U_$GET(BARATYP)_U_$GET(REVERSAL)_U_$GET(REVSCHED)
+17 KILL BAROAMT,BARBBAL
+18 QUIT
+19 ; *********************************************************************
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,BARDIF) ;EP - warner
+1 ;BAR*1.8*4 DD 4.1.7.2 P.OTT
IF BARLVL=4
IF '$$IHS^BARUFUT(DUZ(2))
KILL BARFLG("BARWARN")
QUIT
+2 ;;;I BARLVL=4,'$$IHSERA^BARUFUT(DUZ(2)) K BARFLG("BARWARN") Q ;BAR*1.8*4 DD 4.1.7.2 P.OTT
+3 IF '$GET(BARFLG("BARWARN"))
WRITE !
+4 WRITE *7,!,"Warning - Posted amount exceeds the "
+5 ;BAR*1.8*4 DD 4.1.7.2
WRITE $SELECT(BARLVL=1:"BATCH",BARLVL=2:"ITEM",BARLVL=3:"LOCATION",1:"BILL")_" balance"
+6 ;BAR*1.8*4 DD 4.1.7.2
WRITE " by "_BARDIF_" amount"
+7 SET BARFLG("BARWARN")=1
+8 QUIT
+9 ;
+10 ; *********************************************************************
SETTMPO(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP,BAROAMT) ;EP - store & check amounts;ORIGINAL CODE;BAR*1.8*4
+1 KILL BARFLG("BARWARN")
+2 SET BARSTOP=0
+3 SET BARDA=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+4 IF BARDA=""
QUIT
+5 ; -------------------------------
B1O ;
+1 ;BAR*1.8*4 DD 4.1.7.2
SET BARBBAL=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)
+2 IF BARTYP="P"
Begin DoDot:1
+3 ;BAR*1.8*4 SDD 4.1.7.2
IF (BARBBAL-BARAMT)<0
DO WARN(4,(BARBBAL-BARAMT))
+4 IF +$GET(BAREOB)
IF (BAREOV(4)-(BARPMT+BARAMT))<0
DO WARN(3,(BAREOV(4)-(BARPMT+BARAMT)))
+5 IF (BARITV(19)-(BARPMT+BARAMT))<0
DO WARN(2,(BARITV(19)-(BARPMT+BARAMT)))
+6 IF (BARCLV(17)-(BARPMT+BARAMT))<0
DO WARN(1,(BARCLV(17)-(BARPMT+BARAMT)))
+7 IF $GET(BARFLG("BARWARN"))
Begin DoDot:2
+8 KILL BARFLG("BARWARN")
+9 KILL DIR
+10 SET DIR(0)="Y"
+11 SET DIR("A")="ARE YOU SURE"
+12 SET DIR("B")="NO"
+13 DO ^DIR
+14 KILL DIR
+15 IF Y'=1
SET BARSTOP=1
End DoDot:2
IF BARSTOP
QUIT
+16 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,6)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,6)+BARAMT
+17 SET BARPMT=BARPMT+BARAMT
End DoDot:1
IF BARSTOP
QUIT
+18 IF BARTYP="A"
Begin DoDot:1
+19 ;BAR*1.8*4 SDD 4.1.7.2
IF (BARBBAL-BARAMT)<0
DO WARN(4,(BARBBAL-BARAMT))
+20 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,7)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,7)+BARAMT
+21 SET BARADJ=BARADJ+BARAMT
End DoDot:1
IF BARSTOP
QUIT
+22 IF BARCAT'=21
SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)-BARAMT
+23 SET BARJ=$ORDER(BARTR(BARLIN,""),-1)
+24 SET BARJ=BARJ+1
+25 ;IHS/SD/TPF BAR*1.8*4 UFMS SCR56,SCR58
SET BARTR(BARLIN,BARJ)=BARTYP_U_BARAMT_U_BARCAT_U_$GET(BARATYP)_U_$GET(REVERSAL)_U_$GET(REVSCHED)
+26 QUIT
+27 ; *********************************************************************
