30 lines
1.1 KiB
Mathematica
30 lines
1.1 KiB
Mathematica
|
RCTOP2 ;WASH IRMFO@ALTOONA,PA/TJK-TOP TRANSMISSION ;2/11/00 3:25 PM
|
||
|
|
V ;;4.5;Accounts Receivable;**141,169**;Mar 20, 1995
|
||
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified
|
||
|
|
EN1(DEBTOR,CODE,FILE) ;entry point to compile type 2 documents into global
|
||
|
|
;called from RCTOPD
|
||
|
|
;needs debtor internal number and code:"M" or "U"
|
||
|
|
I $P($G(^RCD(340,DEBTOR,1)),U,9)=1 G QUIT
|
||
|
|
N DEBTOR5,ADDR,LENGTH,DEBNR
|
||
|
|
;
|
||
|
|
;get debtor ar address, compare to top address for 'update' documents
|
||
|
|
;
|
||
|
|
S DEBTOR5=$G(^RCD(340,DEBTOR,5))
|
||
|
|
S ADDR=$$DADD^RCAMADD(DEBTOR),ADDR=$P(ADDR,U,1,2)_U_$P(ADDR,U,4,6)
|
||
|
|
I CODE="U",ADDR=DEBTOR5 G QUIT
|
||
|
|
;
|
||
|
|
;set record in temporary global
|
||
|
|
;
|
||
|
|
S REC="04 "_$P(^RC(342,1,3),U,5)_" "
|
||
|
|
S DEBNR=$E(SITE,1,3)_$S(FILE=2:0,FILE=440:"V",1:"E")_$TR($J(DEBTOR,14)," ",0),REC=REC_DEBNR
|
||
|
|
S REC=REC_$S(CODE="M":"A",1:"U")_2
|
||
|
|
F I=1:1:5 S ADDR(I)=$P(ADDR,U,I),LENGTH=$S(I<3:30,I=3:25,I=4:2,1:9) S:I=5 ADDR(5)=$P(ADDR(5),"-")_$P(ADDR(5),"-",2) S REC=REC_$$LJ^XLFSTR($E(ADDR(I),1,LENGTH),LENGTH)
|
||
|
|
S REC=REC_$$BLANK^RCTOP1(68)
|
||
|
|
S CNTR(2)=CNTR(2)+1,^XTMP("RCTOPD",$J,2,CNTR(2))=REC
|
||
|
|
;
|
||
|
|
;set TOP address in ar debtor file
|
||
|
|
;
|
||
|
|
S ^RCD(340,DEBTOR,5)=ADDR
|
||
|
|
;
|
||
|
|
QUIT Q
|