BARTR ; IHS/SD/LSL - ENTER NEW TRANSACTION DEC 4,1996 ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;;
; ITSC/SD/LSL - 10/10/02 - V1.7 - NOIS QAA-1200-130051
; Modified NEW to a FILE^DICN call
; Added MSG line tag
;
; IHS/SD/LSL - 06/09/03 - V1.7 Patch 1
; Added UPLOAD line take to create new transaction for bills
; That are uploaded to AR using Upload by Date or Upload
; 3P Bill.
;
; ********************************************************************
;
NEW() ;EP - extrensic call to establish a new transaction
; returns 0-lock on file, fm-dt/sec -IEN ; -1 not added
N X,Y,%,DIC,DINUM,D,DA
F I=1:1:5 L +^BARTR(DUZ(2)):2 S X=$T Q:X
I 'X D Q X
. W *7,!!,"A/R TRANSACTION FILE LOCKED see your site manager",!!
F D NOW^%DTC Q:'$D(^BARTR(DUZ(2),"B",%))
S X=%
S DIC="^BARTR(DUZ(2),"
S DIC(0)="NXL"
S DLAYGO=90050
S DINUM=X
K DD,DO
D FILE^DICN
K DLAYGO
L -^BARTR(DUZ(2))
Q +Y
; *********************************************************************
;
EN(BART) ;EP
;
N X,DIC,DA,DR,DIE
S DR=""
S X=""
F S X=$O(BART(X)) Q:X'>0 S DR=DR_X_"////^S X="_BART(X)_";"
S DR=$E(DR,1,$L(DR)-1)
;
S BART("DA")=+Y
I $D(BART("WP")) D
.S ^BARTR(DUZ(2),BART("DA"),10,0)="^^1^1^2950125^"
.S %X="BART(""WP"","
.S %Y="^BARTR(DUZ(2),BART(""DA""),10,"
.D %XY^%RCR
Q
; *********************************************************************
;
DSP(DA) ;EP display transaction (needs DA)
N BARTMP,I
D ENP^XBDIQ1(90050.03,DA,".01:500","BARTMP(")
S I=0
F S I=$O(BARTMP(I)) Q:I'>0 W:BARTMP(I)]"" !,I,?10,$P(^DD(90050.03,I,0),U),?40,BARTMP(I)
D EOP^BARUTL(0)
Q
; *********************************************************************
;
TOTAL(BARTRDA) ;EP
; - **gather BARTOT(tran.cat.type) totals and ADJ in Ax & Tx
D
. D ENP^XBDIQ1(90050.03,BARTRDA,".01;2;3;4;101:103","BART(","I")
. I $L(BART(102)) S BARTOT("A"_BART(102,"I"))=$G(BARTOT("A"_BART(102,"I")))+BART(2)-BART(3) I 1
. E S BARTOT("T"_BART(101,"I"))=$G(BARTOT("T"_BART(101,"I")))+BART(2)-BART(3)
ETOTAL . ;
. S BARTOT($$NODE)=$G(BARTOT($$NODE))+BART(2)-BART(3)
Q
; *********************************************************************
;
NODE() ;
N X
S X=BART(101,"I")_"."_BART(102,"I")_"."_BART(103,"I")
ENODE ;
Q X
; *********************************************************************
;
PAY() ;EP ** Extrensic for PAYMENT field of transaction file
;** If new categories of adjustments or payments are added the
; following code needs to be modified accordingly
N BART
D ENP^XBDIQ1(90050.03,D0,"3.5;101;102","BART(","I")
F I=101,102 S BART(I)=BART(I,"I")
S BART=BART(3.5)
;40 - payment
I BART(101)=40 Q BART
;19 - refund
I BART(102)=19 Q BART
;20 - payment credit
I BART(102)=20 Q BART
K BART
Q ""
; *********************************************************************
;
ADJ() ;EP - ** Extrensic for ADJUSTMENT field of transaction file
;** If new categories of adjustments or payments are added the
; following code needs to be modified accordingly
N BART
D ENP^XBDIQ1(90050.03,D0,"3.5;101;102","BART(","I")
F I=102 S BART(I)=BART(I,"I")
S BART=""
F I=3,4,13,14,15,16 I BART(102)=I S BART=BART(3.5) Q
Q BART
; *********************************************************************
;
VALADJ(BARTYP) ;EP - ** Extrensic to return amount when given type of adjustment
; uses field 102
N BARTR,X
S BARTR=$$VALI^XBDIQ1(90050.03,D0,102)
I BARTR'=BARTYP Q ""
S X=$$VAL^XBDIQ1(90050.03,D0,3.5)
Q X
; *********************************************************************
;
; dd computed field
PAR() ;EP - return 1 if transaction is a PAY!ADJ!REF
N X,Y
S X=1
S Y=$P($G(^BARTR(DUZ(2),D0,1)),U)
I Y'=39,Y'=40,Y'=43,Y'=108 S X=0
Q X
; *********************************************************************
;
PRMBLAMT() ;EP Extrinsic to return Prime Bill Amount
; if tran = 49:BILL NEW field 101 1:p1
; if Bill Type = P'rimary field 16 0:p16
; return debit field 3 0:p3
S X=""
I +$G(^BARTR(DUZ(2),D0,1))'=49 Q X
I $E($P(^BARTR(DUZ(2),D0,0),U,16))'="P" Q X
S X=$P(^BARTR(DUZ(2),D0,0),U,3)
Q X
; *********************************************************************
;
MSG(X) ; EP - error message
; X = Bill IEN
N XVAL
S XVAL=$$GET1^DIQ(90050.01,X,.01)
W:BARTRIEN'=0 !!,*7,$$CJ^XLFSTR("Could not create an entry in A/R Transaction File.",IOM)
W !,$$CJ^XLFSTR("Please verify postings for "_XVAL_" and repost if necessary.",IOM)
Q
; ********************************************************************
;
UPLOAD() ;
; EP - New transaction if bill Uploaded.
N X,Y,DIC
F I=1:1:5 L +^BARTR(DUZ(2)):5 S X=$T Q:X
I 'X Q X ; File in use. quit.
S DIC="^BARTR(DUZ(2),"
S DIC(0)="XLN"
S DLAYGO=90050
S BARHRS=230000
S BARDONE=0
F D Q:BARDONE Q:BARHRS>235959
. S BARHRS=BARHRS+1
. I $E(BARHRS,5,6)=60 D Q:BARHRS>235959
. . S BARHRS=$E(BARHRS,1,4)_"00"
. . S BARHRS=BARHRS+100
. S X=+($P(@BAR3PUP@("DTAP"),".")_"."_BARHRS)
. Q:$D(^BARTR(DUZ(2),"B",X))
. S BARDONE=1
Q:'BARDONE
K DD,DO
D ^DIC
K DLAYGO
L -^BARTR(DUZ(2))
S BARTRIEN=+Y
Q BARTRIEN
BARTR ; IHS/SD/LSL - ENTER NEW TRANSACTION DEC 4,1996 ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;;
+3 ; ITSC/SD/LSL - 10/10/02 - V1.7 - NOIS QAA-1200-130051
+4 ; Modified NEW to a FILE^DICN call
+5 ; Added MSG line tag
+6 ;
+7 ; IHS/SD/LSL - 06/09/03 - V1.7 Patch 1
+8 ; Added UPLOAD line take to create new transaction for bills
+9 ; That are uploaded to AR using Upload by Date or Upload
+10 ; 3P Bill.
+11 ;
+12 ; ********************************************************************
+13 ;
NEW() ;EP - extrensic call to establish a new transaction
+1 ; returns 0-lock on file, fm-dt/sec -IEN ; -1 not added
+2 NEW X,Y,%,DIC,DINUM,D,DA
+3 FOR I=1:1:5
LOCK +^BARTR(DUZ(2)):2
SET X=$TEST
IF X
QUIT
+4 IF 'X
Begin DoDot:1
+5 WRITE *7,!!,"A/R TRANSACTION FILE LOCKED see your site manager",!!
End DoDot:1
QUIT X
+6 FOR
DO NOW^%DTC
IF '$DATA(^BARTR(DUZ(2),"B",%))
QUIT
+7 SET X=%
+8 SET DIC="^BARTR(DUZ(2),"
+9 SET DIC(0)="NXL"
+10 SET DLAYGO=90050
+11 SET DINUM=X
+12 KILL DD,DO
+13 DO FILE^DICN
+14 KILL DLAYGO
+15 LOCK -^BARTR(DUZ(2))
+16 QUIT +Y
+17 ; *********************************************************************
+18 ;
EN(BART) ;EP
+1 ;
+2 NEW X,DIC,DA,DR,DIE
+3 SET DR=""
+4 SET X=""
+5 FOR
SET X=$ORDER(BART(X))
IF X'>0
QUIT
SET DR=DR_X_"////^S X="_BART(X)_";"
+6 SET DR=$EXTRACT(DR,1,$LENGTH(DR)-1)
+7 ;
+8 SET BART("DA")=+Y
+9 IF $DATA(BART("WP"))
Begin DoDot:1
+10 SET ^BARTR(DUZ(2),BART("DA"),10,0)="^^1^1^2950125^"
+11 SET %X="BART(""WP"","
+12 SET %Y="^BARTR(DUZ(2),BART(""DA""),10,"
+13 DO %XY^%RCR
End DoDot:1
+14 QUIT
+15 ; *********************************************************************
+16 ;
DSP(DA) ;EP display transaction (needs DA)
+1 NEW BARTMP,I
+2 DO ENP^XBDIQ1(90050.03,DA,".01:500","BARTMP(")
+3 SET I=0
+4 FOR
SET I=$ORDER(BARTMP(I))
IF I'>0
QUIT
IF BARTMP(I)]""
WRITE !,I,?10,$PIECE(^DD(90050.03,I,0),U),?40,BARTMP(I)
+5 DO EOP^BARUTL(0)
+6 QUIT
+7 ; *********************************************************************
+8 ;
TOTAL(BARTRDA) ;EP
+1 ; - **gather BARTOT(tran.cat.type) totals and ADJ in Ax & Tx
+2 Begin DoDot:1
+3 DO ENP^XBDIQ1(90050.03,BARTRDA,".01;2;3;4;101:103","BART(","I")
+4 IF $LENGTH(BART(102))
SET BARTOT("A"_BART(102,"I"))=$GET(BARTOT("A"_BART(102,"I")))+BART(2)-BART(3)
IF 1
+5 IF '$TEST
SET BARTOT("T"_BART(101,"I"))=$GET(BARTOT("T"_BART(101,"I")))+BART(2)-BART(3)
ETOTAL ;
+1 SET BARTOT($$NODE)=$G(BARTOT($$NODE))+BART(2)-BART(3)
End DoDot:1
+2 QUIT
+3 ; *********************************************************************
+4 ;
NODE() ;
+1 NEW X
+2 SET X=BART(101,"I")_"."_BART(102,"I")_"."_BART(103,"I")
ENODE ;
+1 QUIT X
+2 ; *********************************************************************
+3 ;
PAY() ;EP ** Extrensic for PAYMENT field of transaction file
+1 ;** If new categories of adjustments or payments are added the
+2 ; following code needs to be modified accordingly
+3 NEW BART
+4 DO ENP^XBDIQ1(90050.03,D0,"3.5;101;102","BART(","I")
+5 FOR I=101,102
SET BART(I)=BART(I,"I")
+6 SET BART=BART(3.5)
+7 ;40 - payment
+8 IF BART(101)=40
QUIT BART
+9 ;19 - refund
+10 IF BART(102)=19
QUIT BART
+11 ;20 - payment credit
+12 IF BART(102)=20
QUIT BART
+13 KILL BART
+14 QUIT ""
+15 ; *********************************************************************
+16 ;
ADJ() ;EP - ** Extrensic for ADJUSTMENT field of transaction file
+1 ;** If new categories of adjustments or payments are added the
+2 ; following code needs to be modified accordingly
+3 NEW BART
+4 DO ENP^XBDIQ1(90050.03,D0,"3.5;101;102","BART(","I")
+5 FOR I=102
SET BART(I)=BART(I,"I")
+6 SET BART=""
+7 FOR I=3,4,13,14,15,16
IF BART(102)=I
SET BART=BART(3.5)
QUIT
+8 QUIT BART
+9 ; *********************************************************************
+10 ;
VALADJ(BARTYP) ;EP - ** Extrensic to return amount when given type of adjustment
+1 ; uses field 102
+2 NEW BARTR,X
+3 SET BARTR=$$VALI^XBDIQ1(90050.03,D0,102)
+4 IF BARTR'=BARTYP
QUIT ""
+5 SET X=$$VAL^XBDIQ1(90050.03,D0,3.5)
+6 QUIT X
+7 ; *********************************************************************
+8 ;
+9 ; dd computed field
PAR() ;EP - return 1 if transaction is a PAY!ADJ!REF
+1 NEW X,Y
+2 SET X=1
+3 SET Y=$PIECE($GET(^BARTR(DUZ(2),D0,1)),U)
+4 IF Y'=39
IF Y'=40
IF Y'=43
IF Y'=108
SET X=0
+5 QUIT X
+6 ; *********************************************************************
+7 ;
PRMBLAMT() ;EP Extrinsic to return Prime Bill Amount
+1 ; if tran = 49:BILL NEW field 101 1:p1
+2 ; if Bill Type = P'rimary field 16 0:p16
+3 ; return debit field 3 0:p3
+4 SET X=""
+5 IF +$GET(^BARTR(DUZ(2),D0,1))'=49
QUIT X
+6 IF $EXTRACT($PIECE(^BARTR(DUZ(2),D0,0),U,16))'="P"
QUIT X
+7 SET X=$PIECE(^BARTR(DUZ(2),D0,0),U,3)
+8 QUIT X
+9 ; *********************************************************************
+10 ;
MSG(X) ; EP - error message
+1 ; X = Bill IEN
+2 NEW XVAL
+3 SET XVAL=$$GET1^DIQ(90050.01,X,.01)
+4 IF BARTRIEN'=0
WRITE !!,*7,$$CJ^XLFSTR("Could not create an entry in A/R Transaction File.",IOM)
+5 WRITE !,$$CJ^XLFSTR("Please verify postings for "_XVAL_" and repost if necessary.",IOM)
+6 QUIT
+7 ; ********************************************************************
+8 ;
UPLOAD() ;
+1 ; EP - New transaction if bill Uploaded.
+2 NEW X,Y,DIC
+3 FOR I=1:1:5
LOCK +^BARTR(DUZ(2)):5
SET X=$TEST
IF X
QUIT
+4 ; File in use. quit.
IF 'X
QUIT X
+5 SET DIC="^BARTR(DUZ(2),"
+6 SET DIC(0)="XLN"
+7 SET DLAYGO=90050
+8 SET BARHRS=230000
+9 SET BARDONE=0
+10 FOR
Begin DoDot:1
+11 SET BARHRS=BARHRS+1
+12 IF $EXTRACT(BARHRS,5,6)=60
Begin DoDot:2
+13 SET BARHRS=$EXTRACT(BARHRS,1,4)_"00"
+14 SET BARHRS=BARHRS+100
End DoDot:2
IF BARHRS>235959
QUIT
+15 SET X=+($PIECE(@BAR3PUP@("DTAP"),".")_"."_BARHRS)
+16 IF $DATA(^BARTR(DUZ(2),"B",X))
QUIT
+17 SET BARDONE=1
End DoDot:1
IF BARDONE
QUIT
IF BARHRS>235959
QUIT
+18 IF 'BARDONE
QUIT
+19 KILL DD,DO
+20 DO ^DIC
+21 KILL DLAYGO
+22 LOCK -^BARTR(DUZ(2))
+23 SET BARTRIEN=+Y
+24 QUIT BARTRIEN
