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

RCXFMSCR.m

Go to the documentation of this file.
  1. RCXFMSCR ;WISC/RFJ-fms cash receipt (cr) code sheet generator ;1 Oct 97
  1. ;;4.5;Accounts Receivable;**90,114,148,172,204,203,173,220,184,375**;Mar 20, 1995;Build 15
  1. ;;Per VHA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. BUILDCR(RCRECTDA,RCGECSDA,RCEFT) ; generate a cr/tr code sheet for a receipt
  1. ; rcgecsda is the ien for the gcs stack file 2100.1 for rebuilds
  1. ; rceft = 1 if processing CR for an EFT deposit (CR to rev src cd 8NZZ)
  1. ; = 2 if processing TR for the receipt detail relating to an EFT
  1. ; (TR from 528704/8NZZ to original fund/rsc)
  1. ;
  1. N AMOUNT,BILLDA,COUNT,CR2,DETAIL,DEPOSIT,DESCRIP,DOCTOTAL,FISCALYR,FMSTYPE,FUND,GECSFMS,LINE,RCDEPTDA,REVSRCE,TOTAL,TRANDA,TRANNUMB,UNAPPLY,UNAPPNUM,VENDORID,DEBIT
  1. ;
  1. ; build the lines for all payments on receipt
  1. S RCEFT=+$G(RCEFT)
  1. K ^TMP($J,"RCFMSCR") ; used for 215 report, not used here
  1. D FMSLINES^RCXFMSC1(RCRECTDA)
  1. K ^TMP($J,"RCFMSCR")
  1. ;
  1. ; unapplied payments to accounts
  1. S TRANDA=0 F S TRANDA=$O(^RCY(344,RCRECTDA,1,TRANDA)) Q:'TRANDA D
  1. . ; dollars applied in AR
  1. . I $P(^RCY(344,RCRECTDA,1,TRANDA,0),"^",5) Q
  1. . ; no dollars on transaction
  1. . S AMOUNT=$P(^RCY(344,RCRECTDA,1,TRANDA,0),"^",4) I 'AMOUNT Q
  1. . ;
  1. . ; PRCA*4.5*375 - If sending CR doc, check for debit; if debit, subtract amount instead of add
  1. . I RCEFT=1 D Q
  1. . . N DATE
  1. . . S DATE=$S(DT<3030926:"",DT'<3030926&(DT<$$ADDPTEDT^PRCAACC()):".4",1:"04")
  1. . . S:$P(^RCY(344,RCRECTDA,1,TRANDA,0),"^",29)="D" AMOUNT=-AMOUNT
  1. . . S TOTAL("5287"_DATE,"8NZZ","MCCFVALUE")=$G(TOTAL("5287"_$S(DT<3030926:"",1:"04"),"8NZZ","MCCFVALUE"))+AMOUNT
  1. . S UNAPPLY($$GETUNAPP(RCRECTDA,TRANDA,1))=AMOUNT
  1. ;
  1. ; no code sheets to send
  1. I '$D(DETAIL),'$D(TOTAL),'$D(UNAPPLY) Q "-1^No code sheets to send for this receipt"
  1. ;
  1. ; get the next common number in the series = station "-" nextnumber
  1. ; use (field 200 in file 344) if document previously sent
  1. S TRANNUMB=$P($P($G(^RCY(344,RCRECTDA,2)),"^"),"-",2)
  1. I TRANNUMB="" S TRANNUMB=$$ENUM^RCMSNUM
  1. I TRANNUMB<0 Q "0^Unable to lookup next transaction number"
  1. ; remove the dash (i,e, 460-K1A05HY)
  1. S TRANNUMB=$TR(TRANNUMB,"-")
  1. ;
  1. S FISCALYR=$$FY^RCFN01(DT)
  1. ;
  1. S COUNT=0,DOCTOTAL=0
  1. ; build detail line
  1. S FMSTYPE="" F S FMSTYPE=$O(DETAIL(FMSTYPE)) Q:FMSTYPE="" D
  1. . S BILLDA=0 F S BILLDA=$O(DETAIL(FMSTYPE,BILLDA)) Q:'BILLDA D
  1. . . S AMOUNT=DETAIL(FMSTYPE,BILLDA),DOCTOTAL=DOCTOTAL+AMOUNT
  1. . . S COUNT=COUNT+1
  1. . . S LINE(COUNT)="LIN^~CRA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
  1. . . S $P(LINE(COUNT),"^",20)=$J(AMOUNT,0,2)
  1. . . S $P(LINE(COUNT),"^",21)="I"
  1. . . S $P(LINE(COUNT),"^",23)=FMSTYPE
  1. . . S $P(LINE(COUNT),"^",24)="BD"
  1. . . S $P(LINE(COUNT),"^",25)=$TR($P(^PRCA(430,BILLDA,0),"^"),"-")
  1. . . S $P(LINE(COUNT),"^",26)=$$LINE^RCXFMSC1(BILLDA)
  1. . . S $P(LINE(COUNT),"^",27)="~"
  1. ;
  1. ; build summary line
  1. S FUND="" F S FUND=$O(TOTAL(FUND)) Q:FUND="" D
  1. . S REVSRCE="" F S REVSRCE=$O(TOTAL(FUND,REVSRCE)) Q:REVSRCE="" D
  1. . . S VENDORID="" F S VENDORID=$O(TOTAL(FUND,REVSRCE,VENDORID)) Q:VENDORID="" D
  1. . . . S AMOUNT=TOTAL(FUND,REVSRCE,VENDORID),DOCTOTAL=DOCTOTAL+AMOUNT
  1. . . . S DEBIT="" ; PRCA*4.5*375 - If negative amount, set debit flag
  1. . . . S:AMOUNT<0 DEBIT=1,AMOUNT=$FN(AMOUNT,"-") ; PRCA*4.5*375 - If negative amount, set debit flag
  1. . . . S COUNT=COUNT+1
  1. . . . S LINE(COUNT)="LIN^~CRA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
  1. . . . S $P(LINE(COUNT),"^",4)=$S(FUND=4032:"03",1:FISCALYR)
  1. . . . S $P(LINE(COUNT),"^",4)=$S($E(FUND,1,4)=5287:"05",1:FISCALYR)
  1. . . . S $P(LINE(COUNT),"^",6)=FUND
  1. . . . S $P(LINE(COUNT),"^",7)=$E(TRANNUMB,1,3) ; station #
  1. . . . S $P(LINE(COUNT),"^",10)=REVSRCE
  1. . . . ;I FUND=4032 S $P(LINE(COUNT),"^",13)="24GX40100"
  1. . . . S $P(LINE(COUNT),"^",18)=VENDORID
  1. . . . S $P(LINE(COUNT),"^",20)=$J(AMOUNT,0,2)
  1. . . . S $P(LINE(COUNT),"^",21)=$S(DEBIT:"D",1:"I") ; PRCA*4.5*375 - Send Debit Flag if to FMS
  1. . . . S $P(LINE(COUNT),"^",23)=23
  1. . . . S $P(LINE(COUNT),"^",24)="~"
  1. ;
  1. ; build unapplied payment lines
  1. S UNAPPNUM="" F S UNAPPNUM=$O(UNAPPLY(UNAPPNUM)) Q:UNAPPNUM="" D
  1. . S AMOUNT=UNAPPLY(UNAPPNUM),DOCTOTAL=DOCTOTAL+AMOUNT
  1. . S COUNT=COUNT+1
  1. . S LINE(COUNT)="LIN^~CRA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
  1. . S $P(LINE(COUNT),"^",4)=FISCALYR
  1. . S $P(LINE(COUNT),"^",6)=3875
  1. . S $P(LINE(COUNT),"^",7)=$E(TRANNUMB,1,3) ; station #
  1. . S $P(LINE(COUNT),"^",20)=$J(AMOUNT,0,2)
  1. . S $P(LINE(COUNT),"^",21)="I"
  1. . S $P(LINE(COUNT),"^",23)=17
  1. . S $P(LINE(COUNT),"^",24)="~CRB"
  1. . S $P(LINE(COUNT),"^",32)=UNAPPNUM
  1. . S $P(LINE(COUNT),"^",33)="~"
  1. ;
  1. ; get data from file 344.1, the ar deposit file
  1. S RCDEPTDA=$P(^RCY(344,RCRECTDA,0),"^",6),DEPOSIT=$G(^RCY(344.1,RCDEPTDA,0))
  1. ;
  1. ; build cr2, $p(deposit,^,3)=deposit date
  1. N FMSDT S FMSDT=$$FMSDATE^RCBEUTRA(DT)
  1. S CR2="CR2^"_$E(FMSDT,2,3)_"^"_$E(FMSDT,4,5)_"^"_$E(FMSDT,6,7)_"^^^^^^E^^^"
  1. S CR2=CR2_$P(DEPOSIT,"^")_"^^"_$FN(DOCTOTAL,"-",2)_"^^" ; PRCA*4.5*375 - Suppress minus sign so we don't send negative values to FMS
  1. S CR2=CR2_$E($P(DEPOSIT,"^",3),2,3)_"^"_$E($P(DEPOSIT,"^",3),4,5)_"^"_$E($P(DEPOSIT,"^",3),6,7)_"^~"
  1. ;
  1. ; put together document in gcs
  1. N %DT,D,D0,DA,DI,DIC,DIE,DIQ2,DQ,DR
  1. S DESCRIP="Receipt: "_$P(^RCY(344,RCRECTDA,0),"^")
  1. I 'RCGECSDA D CONTROL^GECSUFMS("A",$E(TRANNUMB,1,3),TRANNUMB,"CR",10,0,"",DESCRIP)
  1. I RCGECSDA D REBUILD^GECSUFM1(RCGECSDA,"A",10,"N","Rebuild "_DESCRIP) S GECSFMS("DA")=RCGECSDA
  1. ;
  1. ; store document in gcs
  1. D SETCS^GECSSTAA(GECSFMS("DA"),CR2)
  1. F COUNT=1:1 Q:'$D(LINE(COUNT)) D SETCS^GECSSTAA(GECSFMS("DA"),LINE(COUNT))
  1. D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
  1. D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
  1. ;
  1. ; add/update entry in file 347 for unprocessed document report
  1. N %DT,%X,D,DA347,D0,DI,DQ,DIC,ERROR,FMSDOCNO,X
  1. S FMSDOCNO="CR-"_$P(GECSFMS("CTL"),"^",9)
  1. S DA347=$O(^RC(347,"C",FMSDOCNO,0))
  1. ; if not in the file, addit fmsdocid cr id
  1. I 'DA347 D OPEN^RCFMDRV1(FMSDOCNO,3,"RC"_$P($G(^RCY(344,RCRECTDA,0)),"^"),.DA347,.ERROR)
  1. I DA347 D SSTAT^RCFMFN02(FMSDOCNO,1)
  1. ;
  1. ; return 1 for success ^ fms document transaction number
  1. Q "1^"_FMSDOCNO
  1. ;
  1. ;
  1. GETUNAPP(RCRECTDA,RCTRANDA,RCSTORE) ; get unapplied deposit number for receipt
  1. ; if $g(rcstore) store it with transaction
  1. N UNAPPNUM
  1. ; if number is already assigned, use it
  1. I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)'="" Q $P(^(2),"^",5)
  1. ;
  1. S UNAPPNUM=$P(^RCY(344,RCRECTDA,0),"^")
  1. ; if the receipt number is more than 9 characters, take the last 9
  1. I $L(UNAPPNUM)>9 S UNAPPNUM=$E(UNAPPNUM,$L(UNAPPNUM)-8,$L(UNAPPNUM))
  1. S UNAPPNUM=UNAPPNUM_$TR($J(RCTRANDA,4)," ",0)
  1. ;
  1. ; store unapplied number
  1. I $G(RCSTORE) D SETUNAPP^RCDPURET(RCRECTDA,RCTRANDA,UNAPPNUM)
  1. ;
  1. Q UNAPPNUM