source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCTOP2.m@ 1739

Last change on this file since 1739 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1RCTOP2 ;WASH IRMFO@ALTOONA,PA/TJK-TOP TRANSMISSION ;2/11/00 3:25 PM
2V ;;4.5;Accounts Receivable;**141,169**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified
4EN1(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 ;
29QUIT Q
Note: See TracBrowser for help on using the repository browser.