RCTOP4.m

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 ---RCTOP4   788     printed  Apr 09, 2024@20:48:05                                                                                                                                                                                                       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