BARPNP4 ; IHS/SD/LSL - POSTING EDIT OF TRANSACTIONS ; 08/22/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**4,7**;OCT 26, 2005
;
; IHS/SD/LSL - 12/24/2002 - V1.7 - XJG-1202-160021
; When posting refunds allow edit of ONLY refund.
;
; *********************************************************************
;
EN ;EP
I '$D(BARTR(BARLIN)) D G ASKCOM^BARPNP3
.W *7,!!,"No transactions to Edit."
.D EOP^BARUTL(1)
N BARSEL
S (BARSEL,BARJ)=0
S BARSEL=$$DSPLY(BARLIN)
W !
S DIR(0)="N^1:"_BARSEL
D ^DIR
K DIR
I $D(DUOUT) G ASKCOM^BARPNP3
S BARSEL=Y
; -------------------------------
;
PARSE ;
S BARLIN=$O(BARSEL(BARSEL,""))
Q:'BARLIN
S BARV=$O(BARSEL(BARSEL,BARLIN,""))
Q:'BARV
N BARREC
S BARREC=BARTR(BARLIN,BARV)
S BARTYP=$P(BARREC,U,1)
S (BAROAMT,BARAMT)=$P(BARREC,U,2)
S BARCAT=$P(BARREC,U,3)
S BARATYP=$P(BARREC,U,4)
; -------------------------------
;
ASKAMT ;
;S BARASK=$S(BARTYP="P":"Payment ",BARTYP="A":"Adjustment ",1:"")_"Amount: "
W !!,BARASK_$J(BARAMT,0,2)_"// " R X:DTIME
I X="" S X=BARAMT
S X=$$AMT^BARPNPU(X)
I X="^" G ASKCOM^BARPNP3
I X="?" W *7," Must be a valid number!" G ASKAMT
S BARAMT=X
I BARTYP="P" G S1
I BARTYP="R" D
.S BARCAT=19
.S BARAMT=-BARAMT
;
;** adjustment category/type dialog
S DIC("B")=BARCAT
S DIC=90052.01
S DIC(0)="AEMNQZ"
S DIC("A")="Adjustment Category: "
S DIC("S")="I Y=3!(Y=4)!(Y=13)!(Y=14)!(Y=15)!(Y=16)!(Y=20)!(Y=21)!(Y=22)"
S:BARTYP="R" DIC("S")="I Y=19"
K DD,DO
D ^DIC
K DIC
I +Y<0 W *7 W !! G ASKAMT
S BARCAT=+Y
S:BARCAT=16 BARAMT=-BARAMT ;grouper
S BARX=0,BARJ=0 K BARK
F S BARX=$O(^BARTBL("D",BARCAT,BARX)) Q:'BARX D Q:BARJ>1
.S BARJ=BARJ+1
.Q:BARJ>1
.S BARK=BARX
I BARJ=1,$G(BARK) S BARATYP=BARK G S1
S DIC("B")=BARATYP
S DIC=90052.02
S DIC(0)="AEMNQZ"
S DIC("A")="Adjustment Type: "
S DIC("S")="I $P(^(0),U,2)=BARCAT"
K DD,DO
D ^DIC
K DIC
I +Y<0 W *7,!! G ASKAMT
S BARATYP=+Y
; -------------------------------
;
S1 ;
D SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP)
G ASKCOM^BARPNP3
; *********************************************************************
SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ; HEAVILY MODIFIED;BAR*1.8*4 DD 4.1.7.2
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
.S BARBBAL=BARBBAL+BAROAMT
.D CKNEG^BARPST4(BARBBAL,0,BARAMT) ;CHECK FOR NEGATIVE BALANCES
Q:BARSTOP
B1 ;
I BARTYP="R" D
.Q:BAROAMT=BARAMT ;AMOUNT NOT CHANGED;MRS:BAR*1.8*7 IM30227
.S BARBBAL=BARBBAL-BARAMT
.S BARADJ=BARADJ+BARAMT-BAROAMT
.S BARREF=BARREF+BARAMT-BAROAMT
.S $P(^BARTMP($J,BARDA,BARLIN),U,7)=BARADJ
.S $P(^BARTMP($J,BARDA,BARLIN),U,5)=BARBBAL
;
I BARTYP="A" D
.Q:BAROAMT=BARAMT ;AMOUNT NOT CHANGED;MRS:BAR*1.8*7 IM30227
.S $P(^BARTMP($J,BARDA,BARLIN),U,7)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,7)+BARAMT-BAROAMT
.S BARADJ=BARADJ+BARAMT-BAROAMT
.S:BARCAT'=21&(BARCAT'=22) $P(^BARTMP($J,BARDA,BARLIN),U,5)=$P(^BARTMP($J,BARDA,BARLIN),U,5)-BARAMT
S BARTR(BARLIN,BARV)=BARTYP_U_BARAMT_U_BARCAT_U_BARATYP
K BAROAMT,BARBBAL
Q
;
; *********************************************************************
;
DSPLY(BARLIN) ;EP - display bill entity
N BARPG,BARJ
S BARPG=0
D HEAD
S (BARJ,BARSEL)=0
F S BARJ=$O(BARTR(BARLIN,BARJ)) Q:'BARJ D
.S BARSEL=BARSEL+1
.W !,?1,BARSEL_"."
.W ?8,$P(BARTR(BARLIN,BARJ),U,1)
.W ?13,$J($P(BARTR(BARLIN,BARJ),U,2),8,2)
.S Y=$P(BARTR(BARLIN,BARJ),U,3)
.I Y W ?25,$E($P(^BAR(90052.01,Y,0),U,1),1,23)
.S Y=$P(BARTR(BARLIN,BARJ),U,4)
.I Y W ?50,$E($P(^BARTBL(Y,0),U,1),1,28)
.S BARSEL(BARSEL,BARLIN,BARJ)=""
.Q
Q BARSEL
; *********************************************************************
;
HEAD ;
W $$EN^BARVDF("IOF"),!
S BARPG=BARPG+1
W "Transactions for "_$P(^DPT(+BARPASS,0),U,1)_" from "_$$SDT^BARDUTL($P(BARPASS,U,2))_" to "_$$SDT^BARDUTL($P(BARPASS,U,3))
W ?(IOM-15),"Page: "_BARPG
W !!
W "Trans",?8,"Type",?15,"Amount",?25,"Category",?50,"Adj. Type"
S BARDSH=""
S $P(BARDSH,"-",IOM)=""
W !,BARDSH
Q
SETTMPO(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ; ORIGINAL CODE;BAR*1.8*4 DD 4.1.7.2
K BARFLG("BARWARN")
S BARSTOP=0
S BARDA=$O(^BARTMP($J,"B",BARLIN,""))
B1O ;
I BARTYP="A" D
.S $P(^BARTMP($J,BARDA,BARLIN),U,7)=$P($G(^BARTMP($J,BARDA,BARLIN)),U,7)+BARAMT-BAROAMT
.S BARADJ=BARADJ+BARAMT-BAROAMT
S $P(^BARTMP($J,BARDA,BARLIN),U,5)=$P(^BARTMP($J,BARDA,BARLIN),U,5)-BARAMT+BAROAMT
S BARTR(BARLIN,BARV)=BARTYP_U_BARAMT_U_BARCAT_U_BARATYP
K BAROAMT
Q
BARPNP4 ; IHS/SD/LSL - POSTING EDIT OF TRANSACTIONS ; 08/22/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,7**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - 12/24/2002 - V1.7 - XJG-1202-160021
+4 ; When posting refunds allow edit of ONLY refund.
+5 ;
+6 ; *********************************************************************
+7 ;
EN ;EP
+1 IF '$DATA(BARTR(BARLIN))
Begin DoDot:1
+2 WRITE *7,!!,"No transactions to Edit."
+3 DO EOP^BARUTL(1)
End DoDot:1
GOTO ASKCOM^BARPNP3
+4 NEW BARSEL
+5 SET (BARSEL,BARJ)=0
+6 SET BARSEL=$$DSPLY(BARLIN)
+7 WRITE !
+8 SET DIR(0)="N^1:"_BARSEL
+9 DO ^DIR
+10 KILL DIR
+11 IF $DATA(DUOUT)
GOTO ASKCOM^BARPNP3
+12 SET BARSEL=Y
+13 ; -------------------------------
+14 ;
PARSE ;
+1 SET BARLIN=$ORDER(BARSEL(BARSEL,""))
+2 IF 'BARLIN
QUIT
+3 SET BARV=$ORDER(BARSEL(BARSEL,BARLIN,""))
+4 IF 'BARV
QUIT
+5 NEW BARREC
+6 SET BARREC=BARTR(BARLIN,BARV)
+7 SET BARTYP=$PIECE(BARREC,U,1)
+8 SET (BAROAMT,BARAMT)=$PIECE(BARREC,U,2)
+9 SET BARCAT=$PIECE(BARREC,U,3)
+10 SET BARATYP=$PIECE(BARREC,U,4)
+11 ; -------------------------------
+12 ;
ASKAMT ;
+1 ;S BARASK=$S(BARTYP="P":"Payment ",BARTYP="A":"Adjustment ",1:"")_"Amount: "
+2 WRITE !!,BARASK_$JUSTIFY(BARAMT,0,2)_"// "
READ X:DTIME
+3 IF X=""
SET X=BARAMT
+4 SET X=$$AMT^BARPNPU(X)
+5 IF X="^"
GOTO ASKCOM^BARPNP3
+6 IF X="?"
WRITE *7," Must be a valid number!"
GOTO ASKAMT
+7 SET BARAMT=X
+8 IF BARTYP="P"
GOTO S1
+9 IF BARTYP="R"
Begin DoDot:1
+10 SET BARCAT=19
+11 SET BARAMT=-BARAMT
End DoDot:1
+12 ;
+13 ;** adjustment category/type dialog
+14 SET DIC("B")=BARCAT
+15 SET DIC=90052.01
+16 SET DIC(0)="AEMNQZ"
+17 SET DIC("A")="Adjustment Category: "
+18 SET DIC("S")="I Y=3!(Y=4)!(Y=13)!(Y=14)!(Y=15)!(Y=16)!(Y=20)!(Y=21)!(Y=22)"
+19 IF BARTYP="R"
SET DIC("S")="I Y=19"
+20 KILL DD,DO
+21 DO ^DIC
+22 KILL DIC
+23 IF +Y<0
WRITE *7
WRITE !!
GOTO ASKAMT
+24 SET BARCAT=+Y
+25 ;grouper
IF BARCAT=16
SET BARAMT=-BARAMT
+26 SET BARX=0
SET BARJ=0
KILL BARK
+27 FOR
SET BARX=$ORDER(^BARTBL("D",BARCAT,BARX))
IF 'BARX
QUIT
Begin DoDot:1
+28 SET BARJ=BARJ+1
+29 IF BARJ>1
QUIT
+30 SET BARK=BARX
End DoDot:1
IF BARJ>1
QUIT
+31 IF BARJ=1
IF $GET(BARK)
SET BARATYP=BARK
GOTO S1
+32 SET DIC("B")=BARATYP
+33 SET DIC=90052.02
+34 SET DIC(0)="AEMNQZ"
+35 SET DIC("A")="Adjustment Type: "
+36 SET DIC("S")="I $P(^(0),U,2)=BARCAT"
+37 KILL DD,DO
+38 DO ^DIC
+39 KILL DIC
+40 IF +Y<0
WRITE *7,!!
GOTO ASKAMT
+41 SET BARATYP=+Y
+42 ; -------------------------------
+43 ;
S1 ;
+1 DO SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP)
+2 GOTO ASKCOM^BARPNP3
+3 ; *********************************************************************
SETTMP(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ; HEAVILY MODIFIED;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 SET BARBBAL=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)
+5 IF BARCAT'=21&(BARCAT'=22)
Begin DoDot:1
+6 SET BARBBAL=BARBBAL+BAROAMT
+7 ;CHECK FOR NEGATIVE BALANCES
DO CKNEG^BARPST4(BARBBAL,0,BARAMT)
End DoDot:1
+8 IF BARSTOP
QUIT
B1 ;
+1 IF BARTYP="R"
Begin DoDot:1
+2 ;AMOUNT NOT CHANGED;MRS:BAR*1.8*7 IM30227
IF BAROAMT=BARAMT
QUIT
+3 SET BARBBAL=BARBBAL-BARAMT
+4 SET BARADJ=BARADJ+BARAMT-BAROAMT
+5 SET BARREF=BARREF+BARAMT-BAROAMT
+6 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,7)=BARADJ
+7 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)=BARBBAL
End DoDot:1
+8 ;
+9 IF BARTYP="A"
Begin DoDot:1
+10 ;AMOUNT NOT CHANGED;MRS:BAR*1.8*7 IM30227
IF BAROAMT=BARAMT
QUIT
+11 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,7)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,7)+BARAMT-BAROAMT
+12 SET BARADJ=BARADJ+BARAMT-BAROAMT
+13 IF BARCAT'=21&(BARCAT'=22)
SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)-BARAMT
End DoDot:1
+14 SET BARTR(BARLIN,BARV)=BARTYP_U_BARAMT_U_BARCAT_U_BARATYP
+15 KILL BAROAMT,BARBBAL
+16 QUIT
+17 ;
+18 ; *********************************************************************
+19 ;
DSPLY(BARLIN) ;EP - display bill entity
+1 NEW BARPG,BARJ
+2 SET BARPG=0
+3 DO HEAD
+4 SET (BARJ,BARSEL)=0
+5 FOR
SET BARJ=$ORDER(BARTR(BARLIN,BARJ))
IF 'BARJ
QUIT
Begin DoDot:1
+6 SET BARSEL=BARSEL+1
+7 WRITE !,?1,BARSEL_"."
+8 WRITE ?8,$PIECE(BARTR(BARLIN,BARJ),U,1)
+9 WRITE ?13,$JUSTIFY($PIECE(BARTR(BARLIN,BARJ),U,2),8,2)
+10 SET Y=$PIECE(BARTR(BARLIN,BARJ),U,3)
+11 IF Y
WRITE ?25,$EXTRACT($PIECE(^BAR(90052.01,Y,0),U,1),1,23)
+12 SET Y=$PIECE(BARTR(BARLIN,BARJ),U,4)
+13 IF Y
WRITE ?50,$EXTRACT($PIECE(^BARTBL(Y,0),U,1),1,28)
+14 SET BARSEL(BARSEL,BARLIN,BARJ)=""
+15 QUIT
End DoDot:1
+16 QUIT BARSEL
+17 ; *********************************************************************
+18 ;
HEAD ;
+1 WRITE $$EN^BARVDF("IOF"),!
+2 SET BARPG=BARPG+1
+3 WRITE "Transactions for "_$PIECE(^DPT(+BARPASS,0),U,1)_" from "_$$SDT^BARDUTL($PIECE(BARPASS,U,2))_" to "_$$SDT^BARDUTL($PIECE(BARPASS,U,3))
+4 WRITE ?(IOM-15),"Page: "_BARPG
+5 WRITE !!
+6 WRITE "Trans",?8,"Type",?15,"Amount",?25,"Category",?50,"Adj. Type"
+7 SET BARDSH=""
+8 SET $PIECE(BARDSH,"-",IOM)=""
+9 WRITE !,BARDSH
+10 QUIT
SETTMPO(BARTYP,BARAMT,BARLIN,BARCAT,BARATYP) ; 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,""))
B1O ;
+1 IF BARTYP="A"
Begin DoDot:1
+2 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,7)=$PIECE($GET(^BARTMP($JOB,BARDA,BARLIN)),U,7)+BARAMT-BAROAMT
+3 SET BARADJ=BARADJ+BARAMT-BAROAMT
End DoDot:1
+4 SET $PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)=$PIECE(^BARTMP($JOB,BARDA,BARLIN),U,5)-BARAMT+BAROAMT
+5 SET BARTR(BARLIN,BARV)=BARTYP_U_BARAMT_U_BARCAT_U_BARATYP
+6 KILL BAROAMT
+7 QUIT
