RCTOP4 ;WASH IRMFO@ALTOONA,PA/TJK-TOP TRANSMISSION ;2/11/00 9:39 AM
V ;;4.5;Accounts Receivable;**141**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified
EN1(NAME,TAXID,DEBTOR4,DEBTOR,FILE) ;entry point to compile type 4 documents into global
;called from RCTOP1
I NAME=$P(DEBTOR4,U,5),TAXID=$P(DEBTOR4,U,4) Q
N REC,DEBNR
;
;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)
S REC=REC_DEBNR_"A400"_NAME_" "_$$DATE8^RCTOP1(DT)_TAXID
S REC=REC_$$BLANK^RCTOP1(70)
S CNTR(4)=CNTR(4)+1,^XTMP("RCTOPD",$J,4,CNTR(4))=REC
;
;set TOP alias nodes in debtor file
;
S $P(^RCD(340,DEBTOR,4),U,4)=TAXID,$P(^(4),U,5)=NAME
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTOP4 788 printed Nov 22, 2024@16:59:17 Page 2
RCTOP4 ;WASH IRMFO@ALTOONA,PA/TJK-TOP TRANSMISSION ;2/11/00 9:39 AM
V ;;4.5;Accounts Receivable;**141**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified
EN1(NAME,TAXID,DEBTOR4,DEBTOR,FILE) ;entry point to compile type 4 documents into global
+1 ;called from RCTOP1
+2 IF NAME=$PIECE(DEBTOR4,U,5)
IF TAXID=$PIECE(DEBTOR4,U,4)
QUIT
+3 NEW REC,DEBNR
+4 ;
+5 ;set record in temporary global
+6 ;
+7 SET REC="04 "_$PIECE(^RC(342,1,3),U,5)_" "
+8 SET DEBNR=$EXTRACT(SITE,1,3)_$SELECT(FILE=2:0,FILE=440:"V",1:"E")_$TRANSLATE($JUSTIFY(DEBTOR,14)," ",0)
+9 SET REC=REC_DEBNR_"A400"_NAME_" "_$$DATE8^RCTOP1(DT)_TAXID
+10 SET REC=REC_$$BLANK^RCTOP1(70)
+11 SET CNTR(4)=CNTR(4)+1
SET ^XTMP("RCTOPD",$JOB,4,CNTR(4))=REC
+12 ;
+13 ;set TOP alias nodes in debtor file
+14 ;
+15 SET $PIECE(^RCD(340,DEBTOR,4),U,4)=TAXID
SET $PIECE(^(4),U,5)=NAME
+16 QUIT
