Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCBEUTRA

RCBEUTRA.m

Go to the documentation of this file.
  1. RCBEUTRA ;WISC/RFJ-utilties for transactions (in file 433) ;1 Jun 00
  1. ;;4.5;Accounts Receivable;**153,169,204,326,332**;Mar 20, 1995;Build 40
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. ADD433(BILLDA,TRANTYPE) ; add a new transaction to file 433 (silent)
  1. ; return: ien of 433 transaction or 0^error msg
  1. ; : ^prca(433,ien) will be locked if entry selected
  1. ; Input - optional variable RCDUZ for the processed by user. SET in ^RCDPEAP from MARKED FOR AUTOPOST USER. PRCA*4.5*326
  1. N %I,DA,DATA0,DD,DIC,DICR,DIE,DINUM,DIW,DLAYGO,DO,I,RCTRANDA,REFCODE,X,Y
  1. ;
  1. ; find next available transaction number
  1. ; add an extra level of locks, some operating systems do not process
  1. ; the locks correctly if they happen at the same time.
  1. L +^PRCA(433,"ADDNEWENTRY"):DILOCKTM
  1. I '$T Q "0^Another user is adding an AR Transaction, please try again later."
  1. ; start with last entry in file
  1. ; -> if no data is in the entry, lock it
  1. ; -> if the lock works and no data was added (prior to the lock)
  1. ; -> then you have the entry.
  1. ; -> otherwise, unlock it and start over
  1. F DINUM=$P(^PRCA(433,0),"^",3)+1:1 I '$D(^PRCA(433,DINUM)) L +^PRCA(433,DINUM):DILOCKTM Q:$T&('$D(^PRCA(433,DINUM))) L -^PRCA(433,DINUM)
  1. L -^PRCA(433,"ADDNEWENTRY")
  1. ;
  1. ; add entry to file
  1. S RCTRANDA=DINUM,(DIC,DIE)="^PRCA(433,",DIC(0)="L",DLAYGO=433,X=DINUM
  1. ; build DR string, 42=processed by (use postmaster if queued)
  1. S DIC("DR")="42////"_$S($G(RCDUZ):RCDUZ,$D(ZTQUEUED):.5,1:DUZ)_";" ; PRCA*4.5*326 Use RCDUZ if defined
  1. S DIC("DR")=DIC("DR")_".03////"_BILLDA_";" ;bill ien
  1. S DIC("DR")=DIC("DR")_"12////"_TRANTYPE_";" ;transaction type
  1. S DATA0=$G(^PRCA(430,BILLDA,0))
  1. ; appropriation symbol
  1. I $P(DATA0,"^",18)'="" S DIC("DR")=DIC("DR")_"8////"_$P(DATA0,"^",18)_";"
  1. ; segment
  1. I $P(DATA0,"^",21)'="" S DIC("DR")=DIC("DR")_"6////"_$P(DATA0,"^",21)_";"
  1. ; test for referral code
  1. S REFCODE=$P($G(^PRCA(430,BILLDA,6)),"^",5)
  1. I REFCODE'="" S REFCODE=$S(REFCODE="DC":"RC",1:REFCODE),DIC("DR")=DIC("DR")_"7////"_REFCODE_";"
  1. ; file it
  1. D FILE^DICN
  1. I Y=-1 L -^PRCA(433,RCTRANDA) Q "0^UNABLE TO ADD A NEW ENTRY TO FILE 433"
  1. Q RCTRANDA
  1. ;
  1. ;
  1. FY433(RCTRANDA) ; transfer fiscal year multiple from 430 to 433
  1. ; bill number must be stored in file 433, field .03 before calling
  1. N BILLDA,FY,FYDATA
  1. S BILLDA=+$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'BILLDA Q
  1. K ^PRCA(433,RCTRANDA,4)
  1. S FY=0 F S FY=$O(^PRCA(430,BILLDA,2,FY)) Q:'FY D
  1. . S FYDATA=$G(^PRCA(430,BILLDA,2,FY,0)) I $P(FYDATA,"^")="" Q
  1. . S ^PRCA(433,RCTRANDA,4,FY,0)=$P(FYDATA,"^",1,3)_"^1"
  1. . S ^PRCA(433,RCTRANDA,4,"B",$P(FYDATA,"^"),FY)=""
  1. ;
  1. S ^PRCA(433,RCTRANDA,4,0)="^433.01I^"_$P($G(^PRCA(430,BILLDA,2,0)),"^",3,4)
  1. Q
  1. ;
  1. ;
  1. FYMULT(RCTRANDA) ; apply payment to fy multiple, oldest first
  1. N AMOUNT,FYDA,FYAMOUNT
  1. ; transfer fy multiple if not there
  1. I '$D(^PRCA(433,RCTRANDA,4)) D FY433(RCTRANDA)
  1. ; amount is principal amount
  1. S AMOUNT=$P($$TRANVALU^RCDPBTLM(RCTRANDA),"^",2) I 'AMOUNT Q
  1. ;
  1. ; the transaction value is minus, decrease principal
  1. I AMOUNT<0 D Q
  1. . S AMOUNT=-AMOUNT
  1. . S FYDA=0 F S FYDA=$O(^PRCA(433,RCTRANDA,4,FYDA)) Q:'FYDA D I 'AMOUNT Q
  1. . . S FYAMOUNT=$P($G(^PRCA(433,RCTRANDA,4,FYDA,0)),"^",2)
  1. . . ; fy amount is greater than transaction amount
  1. . . I FYAMOUNT>AMOUNT D Q
  1. . . . S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",2)=FYAMOUNT-AMOUNT
  1. . . . S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",5)=AMOUNT
  1. . . . S AMOUNT=0
  1. . . ; fy amount not greater than total amount
  1. . . S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",2)=0
  1. . . S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",5)=FYAMOUNT
  1. . . S AMOUNT=AMOUNT-FYAMOUNT
  1. . ; move back to 430
  1. . D FYMULT^RCBEUBIL(RCTRANDA)
  1. ;
  1. ; the transaction value is plus, increase principal
  1. S FYDA=$O(^PRCA(433,RCTRANDA,4,999),-1) I 'FYDA Q
  1. S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",2)=$P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",2)+AMOUNT
  1. S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",5)=AMOUNT
  1. ; move back to 430
  1. D FYMULT^RCBEUBIL(RCTRANDA)
  1. Q
  1. ;
  1. ;
  1. EDIT433(RCTRANDA,DR) ; edit the field in 433 with the DR string passed
  1. I '$D(^PRCA(433,RCTRANDA)) Q
  1. N %,D,D0,D1,DA,DDH,DI,DIC,DIE,DQ,J,X,Y
  1. S (DIC,DIE)="^PRCA(433,",DA=RCTRANDA
  1. D ^DIE
  1. ; user pressed up-arrow
  1. I $D(Y) Q "0^TRANSACTION NOT COMPLETELY PROCESSED"
  1. Q 1
  1. ;
  1. ;
  1. PROCESS(RCTRANDA) ; mark transaction as processed
  1. I '$D(^PRCA(433,RCTRANDA,0)) Q
  1. N D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
  1. S (DIC,DIE)="^PRCA(433,",DA=RCTRANDA
  1. S DR="3////0;4////2;"
  1. D ^DIE
  1. Q
  1. ;
  1. ;
  1. INCOMPLE(RCTRANDA) ; opposite of processed, make a transaction incomplete
  1. I '$D(^PRCA(433,RCTRANDA,0)) Q
  1. N D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
  1. S (DIC,DIE)="^PRCA(433,",DA=RCTRANDA
  1. S DR="4////1;"
  1. D ^DIE
  1. Q
  1. ;
  1. ;
  1. DEL433(RCTRANDA,COMMENT,ARCHIVE) ; delete (mark incomplete) in file 433
  1. ; comment is the user comment in field 41 (default USER CANCELLED)
  1. ; archive is set to 1 if called to archive transaction
  1. I '$D(^PRCA(433,RCTRANDA,0)) Q
  1. N %,D,D0,DA,DI,DIC,DIE,DQ,DR,J,RCBILLDA,X,Y
  1. ;
  1. S (DIC,DIE)="^PRCA(433,",DA=RCTRANDA
  1. ; build DR string
  1. S DR=""
  1. S DR=DR_"4////1;" ;transaction status incomplete
  1. S DR=DR_"10////1;" ;incomplete transaction flag
  1. S DR=DR_"11///T;" ;transaction date
  1. I $G(COMMENT)="" S COMMENT="USER CANCELLED"
  1. S DR=DR_"41///"_COMMENT_";"
  1. ; brief comment
  1. S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2)
  1. S DR=DR_"5.02////SYSTEM "_$S($G(ARCHIVE):"ARCHIVED",1:"INACTIVATED")_$S(RCBILLDA:" (BILL "_$P($G(^PRCA(430,RCBILLDA,0)),"^")_")",1:"")_";"
  1. D ^DIE
  1. ; since the bill number (field .03) is required, it must be manually removed
  1. I RCBILLDA S $P(^PRCA(433,RCTRANDA,0),"^",2)="" K ^PRCA(433,"C",RCBILLDA,RCTRANDA)
  1. ; remove fy multiple
  1. K ^PRCA(433,RCTRANDA,4)
  1. Q
  1. ;
  1. ;
  1. ADDCOMM(RCTRANDA,COMMENT) ; automatically put a comment on a transaction
  1. ; comment in the array comment(1)=first line
  1. ; comment(2)=second line
  1. N CURRLINE,LINE
  1. ; get the last line
  1. S CURRLINE=$O(^PRCA(433,RCTRANDA,7,99999999),-1)
  1. ; if comment already on transaction, add a blank line and
  1. ; date time of new comment
  1. I CURRLINE D
  1. . S CURRLINE=CURRLINE+1,^PRCA(433,RCTRANDA,7,CURRLINE,0)=" "
  1. . S CURRLINE=CURRLINE+1,^PRCA(433,RCTRANDA,7,CURRLINE,0)="Comment added on: "_$$FMTE^XLFDT($$NOW^XLFDT)
  1. ; add new lines
  1. F LINE=1:1 Q:'$D(COMMENT(LINE)) S ^PRCA(433,RCTRANDA,7,CURRLINE+LINE,0)=COMMENT(LINE)
  1. ; set the 0th node
  1. S ^PRCA(433,RCTRANDA,7,0)="^^"_(CURRLINE+LINE-1)_"^"_(CURRLINE+LINE-1)_"^"_DT_"^"
  1. Q
  1. FMSDATE(X) ;Finds the next month & year and sets the date for transmission
  1. ;of the document to FMS. If DT is after EOAM and the document has not
  1. ;been previously transmitted, the date will be set to the first of the
  1. ;next month. If the DT is after the EOAM and the document is being
  1. ;re-transmitted, the the date of transmission will be DT. The flag REGEN
  1. ;is set in the source code if the document is being
  1. ;re-transmitted, thus will have a transmission date of DT.
  1. I $G(REFMS) G QUIT
  1. I DT>$$LDATE^RCRJR(DT) S X=$E($$FPS^RCAMFN01(X,1),1,5)_"01"
  1. QUIT Q X