BAREITDN ; IHS/SD/SDR - EDIT COLLECTION BATCH/ITEMS JAN 15,1997 ;04/10/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**4,23**;OCT 26, 2005
; New routine in bar*1.8*4 for DD item 4.1.5.4
;
Q
;
EN ;EP
W !!,"NOTE: Do this option only when posting is not being done. Regular"
W !,"posting locks the A/R Transactions file and doesn't allow other edits"
W !,"to A/R Transactions.",!!
;
PICK I $D(BARLIST) D CLEAR^VALM1
S DIC=$$DIC^XBDIQ1(90050.01)
S DIC(0)="AEQM"
D ^DIC
I Y'>0 G EXIT
S BARBLDA=+Y
; -------------------------------
LIST W !!!,"#",?24,"TRANS"
W !,"#",?4,"TRANSACTION DT/TM"
W ?24,"TYPE",?32,"TDN"
W ?45,"AMOUNT",?56,"BATCH/Item",!
F B=1:1:80 W "-"
;
S BARTRDA=0,BARCNT=0
K BARLIST
F S BARTRDA=$O(^BARTR(DUZ(2),"AC",BARBLDA,BARTRDA)) Q:'BARTRDA D
.S BARTTYP=$$GET1^DIQ(90050.03,BARTRDA_",",101,"E")
.Q:BARTTYP'="PAYMENT" ;only allow edit of payments
.S BARTDTTM=$$TDT^BARDUTL($P($G(^BARTR(DUZ(2),BARTRDA,0)),U))
.S BARCRD=$$GET1^DIQ(90050.03,BARTRDA_",",2,"E")
.S BARDEB=$$GET1^DIQ(90050.03,BARTRDA_",",3,"E")
.S BARBATCH=$P($G(^BARTR(DUZ(2),BARTRDA,0)),U,14)
.S BARITEM=$P($G(^BARTR(DUZ(2),BARTRDA,0)),U,15)
.;
.S BARTDN=""
.I $P($G(^BARTR(DUZ(2),BARTRDA,1)),U,11) S BARTDN=$P(^(1),U,11)
.;Transaction TDN
.I BARTDN="",$P($G(^BARTR(DUZ(2),BARTRDA,0)),U,17) S BARTDN=$P(^(0),U,17)
.;item TDN
.I BARTDN="",$P($G(^BARCOL(DUZ(2),BARBATCH,1,BARITEM,0)),U,20) S BARTDN=$P(^(0),U,20)
.;batch TDN
.I BARTDN="",$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,28) S BARTDN=$P(^(0),U,28)
.;
.S BARCNT=+$G(BARCNT)+1
.S BARLIST(BARCNT)=BARTRDA_"^"
.;
.W !,$J(BARCNT_".","3R"),?4,BARTDTTM
.W ?24,BARTTYP
.W ?32,BARTDN
.W ?45,$J($FN($S($G(BARCRD):-BARCRD,1:$G(BARDEB)),",",2),"9R")
.W:+BARBATCH'=0 ?56,$E($P($G(^BARCOL(DUZ(2),BARBATCH,0)),U)_"-"_BARITEM,1,23)
;
SELECT W !!
K DIR,DIC,DIE,DR,DA,X,Y
S DIR(0)="LO^1:"_BARCNT
S DIR("A")="Select A/R BILL TRANSACTION: "
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) G PICK
S BARSEL=+Y
W !!
D EDIT
Q
;
EDIT ;
S BARENTRY=$P(BARLIST(BARSEL),U)
W !!,"Editing transaction: ",$$TDT^BARDUTL($P($G(^BARTR(DUZ(2),BARENTRY,0)),U))
S BARACCT=$$GET1^DIQ(90050.03,BARENTRY_",",6,"E")
S BARTTYP=$$GET1^DIQ(90050.03,BARENTRY_",",101,"E")
S BARCRD=$$GET1^DIQ(90050.03,BARENTRY_",",2,"E")
S BARDEB=$$GET1^DIQ(90050.03,BARENTRY_",",3,"E")
S BARBATCH=$P($G(^BARTR(DUZ(2),BARENTRY,0)),U,14)
S BARITEM=$P($G(^BARTR(DUZ(2),BARENTRY,0)),U,15)
W !?3,"A/R ACCOUNT: ",BARACCT
W !?3,BARTTYP_" for "_$J($FN($S($G(BARCRD):-BARCRD,1:$G(BARDEB)),",",2),"9R")
W !?3,"Collection Batch/Item: ",$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U)_"-"_BARITEM,!!
;
K DIC,DIE,DIR,DA,DR,X,Y
K BARREV
S BAROVAL=""
S DIR(0)="F^6:20"
I $P($G(^BARTR(DUZ(2),BARENTRY,1)),U,11)'="" D
.S DIR("A")="REV TREASURY DEP NUMBER/IPAC"
.S (DIR("B"),BAROVAL)=$P($G(^BARTR(DUZ(2),BARENTRY,1)),U,11)
I $P($G(^BARTR(DUZ(2),BARENTRY,1)),U,11)="" D
.S DIR("A")="TREASURY DEPOSIT NUMBER/IPAC"
.S:$P($G(^BARTR(DUZ(2),BARENTRY,0)),U,17)'="" (DIR("B"),BAROVAL)=$P($G(^BARTR(DUZ(2),BARENTRY,0)),U,17)
.S:'$D(DIR("B"))&($P($G(^BARCOL(DUZ(2),BARBATCH,1,BARITEM,0)),U,20)'="") (DIR("B"),BAROVAL)=$P($G(^BARCOL(DUZ(2),BARBATCH,1,BARITEM,0)),U,20)
.S:'$D(DIR("B"))&($P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,28)'="") (DIR("B"),BAROVAL)=$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,28)
D ^DIR K DIR
S BARNVAL=Y
;
I BAROVAL'=BARNVAL D
.S DIE="^BARTR(DUZ(2),"
.S DA=BARENTRY
.;reversal TDN
.I $P($G(^BARTR(DUZ(2),BARENTRY,1)),U,11)'="" S DR="111////"_BARNVAL,BARREV=""
.;Transaction TDN
.I $G(DR)="",$P($G(^BARTR(DUZ(2),BARENTRY,0)),U,17)'="" S DR="17////"_BARNVAL
.;item TDN
.I $G(DR)="",$P($G(^BARCOL(DUZ(2),BARBATCH,1,BARITEM,0)),U,20)'="" S DR="17////"_BARNVAL
.;batch TDN
.I $G(DR)="",$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,28)'="" S DR="17////"_BARNVAL
.I $G(DR)="" S DR="17////"_BARNVAL
.D ^DIE
.S DA(1)=BARENTRY
.S DIC="^BARTR(DUZ(2),"_DA(1)_",12,"
.S DIC(0)="LMQ"
.D NOW^%DTC
.S X=%
.S DIC("DR")=".02////"_$S($D(BARREV):"111",1:"20")_";.03////"_BAROVAL_";.04////"_BARNVAL_";.05////"_DUZ
.S DLAYGO=90050
.S DIC("P")=$P(^DD(90050.03,1201,0),U,2)
.D ^DIC
I BAROVAL=BARNVAL D
.W !!,"NOTHING CHANGED." H 2
G LIST
EXIT ;
K BAROVAL,BARNVAL,BARREV,BARENTRY,BARLIST,BARBATCH,BARITEM,BARACCT
K BARCRD,BARDEB,BARBLDA,BARTRDA,BARCNT,BARTDN,BARSEL
Q
BAREITDN ; IHS/SD/SDR - EDIT COLLECTION BATCH/ITEMS JAN 15,1997 ;04/10/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,23**;OCT 26, 2005
+2 ; New routine in bar*1.8*4 for DD item 4.1.5.4
+3 ;
+4 QUIT
+5 ;
EN ;EP
+1 WRITE !!,"NOTE: Do this option only when posting is not being done. Regular"
+2 WRITE !,"posting locks the A/R Transactions file and doesn't allow other edits"
+3 WRITE !,"to A/R Transactions.",!!
+4 ;
PICK IF $DATA(BARLIST)
DO CLEAR^VALM1
+1 SET DIC=$$DIC^XBDIQ1(90050.01)
+2 SET DIC(0)="AEQM"
+3 DO ^DIC
+4 IF Y'>0
GOTO EXIT
+5 SET BARBLDA=+Y
+6 ; -------------------------------
LIST WRITE !!!,"#",?24,"TRANS"
+1 WRITE !,"#",?4,"TRANSACTION DT/TM"
+2 WRITE ?24,"TYPE",?32,"TDN"
+3 WRITE ?45,"AMOUNT",?56,"BATCH/Item",!
+4 FOR B=1:1:80
WRITE "-"
+5 ;
+6 SET BARTRDA=0
SET BARCNT=0
+7 KILL BARLIST
+8 FOR
SET BARTRDA=$ORDER(^BARTR(DUZ(2),"AC",BARBLDA,BARTRDA))
IF 'BARTRDA
QUIT
Begin DoDot:1
+9 SET BARTTYP=$$GET1^DIQ(90050.03,BARTRDA_",",101,"E")
+10 ;only allow edit of payments
IF BARTTYP'="PAYMENT"
QUIT
+11 SET BARTDTTM=$$TDT^BARDUTL($PIECE($GET(^BARTR(DUZ(2),BARTRDA,0)),U))
+12 SET BARCRD=$$GET1^DIQ(90050.03,BARTRDA_",",2,"E")
+13 SET BARDEB=$$GET1^DIQ(90050.03,BARTRDA_",",3,"E")
+14 SET BARBATCH=$PIECE($GET(^BARTR(DUZ(2),BARTRDA,0)),U,14)
+15 SET BARITEM=$PIECE($GET(^BARTR(DUZ(2),BARTRDA,0)),U,15)
+16 ;
+17 SET BARTDN=""
+18 IF $PIECE($GET(^BARTR(DUZ(2),BARTRDA,1)),U,11)
SET BARTDN=$PIECE(^(1),U,11)
+19 ;Transaction TDN
+20 IF BARTDN=""
IF $PIECE($GET(^BARTR(DUZ(2),BARTRDA,0)),U,17)
SET BARTDN=$PIECE(^(0),U,17)
+21 ;item TDN
+22 IF BARTDN=""
IF $PIECE($GET(^BARCOL(DUZ(2),BARBATCH,1,BARITEM,0)),U,20)
SET BARTDN=$PIECE(^(0),U,20)
+23 ;batch TDN
+24 IF BARTDN=""
IF $PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,28)
SET BARTDN=$PIECE(^(0),U,28)
+25 ;
+26 SET BARCNT=+$GET(BARCNT)+1
+27 SET BARLIST(BARCNT)=BARTRDA_"^"
+28 ;
+29 WRITE !,$JUSTIFY(BARCNT_".","3R"),?4,BARTDTTM
+30 WRITE ?24,BARTTYP
+31 WRITE ?32,BARTDN
+32 WRITE ?45,$JUSTIFY($FNUMBER($SELECT($GET(BARCRD):-BARCRD,1:$GET(BARDEB)),",",2),"9R")
+33 IF +BARBATCH'=0
WRITE ?56,$EXTRACT($PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U)_"-"_BARITEM,1,23)
End DoDot:1
+34 ;
SELECT WRITE !!
+1 KILL DIR,DIC,DIE,DR,DA,X,Y
+2 SET DIR(0)="LO^1:"_BARCNT
+3 SET DIR("A")="Select A/R BILL TRANSACTION: "
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
GOTO PICK
+6 SET BARSEL=+Y
+7 WRITE !!
+8 DO EDIT
+9 QUIT
+10 ;
EDIT ;
+1 SET BARENTRY=$PIECE(BARLIST(BARSEL),U)
+2 WRITE !!,"Editing transaction: ",$$TDT^BARDUTL($PIECE($GET(^BARTR(DUZ(2),BARENTRY,0)),U))
+3 SET BARACCT=$$GET1^DIQ(90050.03,BARENTRY_",",6,"E")
+4 SET BARTTYP=$$GET1^DIQ(90050.03,BARENTRY_",",101,"E")
+5 SET BARCRD=$$GET1^DIQ(90050.03,BARENTRY_",",2,"E")
+6 SET BARDEB=$$GET1^DIQ(90050.03,BARENTRY_",",3,"E")
+7 SET BARBATCH=$PIECE($GET(^BARTR(DUZ(2),BARENTRY,0)),U,14)
+8 SET BARITEM=$PIECE($GET(^BARTR(DUZ(2),BARENTRY,0)),U,15)
+9 WRITE !?3,"A/R ACCOUNT: ",BARACCT
+10 WRITE !?3,BARTTYP_" for "_$JUSTIFY($FNUMBER($SELECT($GET(BARCRD):-BARCRD,1:$GET(BARDEB)),",",2),"9R")
+11 WRITE !?3,"Collection Batch/Item: ",$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U)_"-"_BARITEM,!!
+12 ;
+13 KILL DIC,DIE,DIR,DA,DR,X,Y
+14 KILL BARREV
+15 SET BAROVAL=""
+16 SET DIR(0)="F^6:20"
+17 IF $PIECE($GET(^BARTR(DUZ(2),BARENTRY,1)),U,11)'=""
Begin DoDot:1
+18 SET DIR("A")="REV TREASURY DEP NUMBER/IPAC"
+19 SET (DIR("B"),BAROVAL)=$PIECE($GET(^BARTR(DUZ(2),BARENTRY,1)),U,11)
End DoDot:1
+20 IF $PIECE($GET(^BARTR(DUZ(2),BARENTRY,1)),U,11)=""
Begin DoDot:1
+21 SET DIR("A")="TREASURY DEPOSIT NUMBER/IPAC"
+22 IF $PIECE($GET(^BARTR(DUZ(2),BARENTRY,0)),U,17)'=""
SET (DIR("B"),BAROVAL)=$PIECE($GET(^BARTR(DUZ(2),BARENTRY,0)),U,17)
+23 IF '$DATA(DIR("B"))&($PIECE($GET(^BARCOL(DUZ(2),BARBATCH,1,BARITEM,0)),U,20)'="")
SET (DIR("B"),BAROVAL)=$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,1,BARITEM,0)),U,20)
+24 IF '$DATA(DIR("B"))&($PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,28)'="")
SET (DIR("B"),BAROVAL)=$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,28)
End DoDot:1
+25 DO ^DIR
KILL DIR
+26 SET BARNVAL=Y
+27 ;
+28 IF BAROVAL'=BARNVAL
Begin DoDot:1
+29 SET DIE="^BARTR(DUZ(2),"
+30 SET DA=BARENTRY
+31 ;reversal TDN
+32 IF $PIECE($GET(^BARTR(DUZ(2),BARENTRY,1)),U,11)'=""
SET DR="111////"_BARNVAL
SET BARREV=""
+33 ;Transaction TDN
+34 IF $GET(DR)=""
IF $PIECE($GET(^BARTR(DUZ(2),BARENTRY,0)),U,17)'=""
SET DR="17////"_BARNVAL
+35 ;item TDN
+36 IF $GET(DR)=""
IF $PIECE($GET(^BARCOL(DUZ(2),BARBATCH,1,BARITEM,0)),U,20)'=""
SET DR="17////"_BARNVAL
+37 ;batch TDN
+38 IF $GET(DR)=""
IF $PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,28)'=""
SET DR="17////"_BARNVAL
+39 IF $GET(DR)=""
SET DR="17////"_BARNVAL
+40 DO ^DIE
+41 SET DA(1)=BARENTRY
+42 SET DIC="^BARTR(DUZ(2),"_DA(1)_",12,"
+43 SET DIC(0)="LMQ"
+44 DO NOW^%DTC
+45 SET X=%
+46 SET DIC("DR")=".02////"_$SELECT($DATA(BARREV):"111",1:"20")_";.03////"_BAROVAL_";.04////"_BARNVAL_";.05////"_DUZ
+47 SET DLAYGO=90050
+48 SET DIC("P")=$PIECE(^DD(90050.03,1201,0),U,2)
+49 DO ^DIC
End DoDot:1
+50 IF BAROVAL=BARNVAL
Begin DoDot:1
+51 WRITE !!,"NOTHING CHANGED."
HANG 2
End DoDot:1
+52 GOTO LIST
EXIT ;
+1 KILL BAROVAL,BARNVAL,BARREV,BARENTRY,BARLIST,BARBATCH,BARITEM,BARACCT
+2 KILL BARCRD,BARDEB,BARBLDA,BARTRDA,BARCNT,BARTDN,BARSEL
+3 QUIT
