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