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

RCXFMSSV.m

Go to the documentation of this file.
  1. RCXFMSSV ;WISC/RFJ-fms standard voucher (sv) code sheet generator ; 9/7/10 7:43am
  1. ;;4.5;Accounts Receivable;**96,101,135,139,98,156,170,191,203,220,138,184,239,273,357**;Mar 20, 1995;Build 6
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. STARTSV(RCDATEND) ; top entry point to generate a sv code sheet
  1. ;
  1. ; rcdatend is the ending date of the period.
  1. ; This date is the 3rd work day from the end of the month.
  1. ; The utility $$LDATE^RCRJR is used to figure it out. It will
  1. ; change from month to month and figures in holidays also.
  1. ; For example, if running the ARDC for the month of June 2003
  1. ; the EOAM will calculate out to be June 25, 2003.
  1. ; This is called by the background monthly data collector
  1. ;
  1. ; data stored in tmp($j,rcrjrcolsv,type,fund,revsourcecode)
  1. ; this is called by the background monthly data collector
  1. ;
  1. N GECSDATA,RCTRANID,RESULT
  1. ; lookup fms document number to see if the monthly sv has been sent
  1. ; example rcdatend=3010531, lookup on 3010500
  1. D KEYLOOK^GECSSGET("SV-"_$E(RCDATEND,1,5)_"00",1)
  1. ;
  1. ; get the transacion id for the fms document
  1. ; if it is not sent, get the next number available
  1. I $G(GECSDATA) S RCTRANID=$E($P(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
  1. I $G(RCTRANID)="" S RCTRANID=$$ENUM^RCMSNUM
  1. I RCTRANID<0 Q ;unable to retrieve the next number
  1. ; remove dash (example 460-K1A05HY)
  1. S RCTRANID=$TR(RCTRANID,"-")
  1. ;
  1. ; build and send the sv document to fms
  1. S RESULT=$$BUILDSV(RCDATEND,+$G(GECSDATA),RCTRANID,"00")
  1. ; error in building code sheet
  1. I 'RESULT Q
  1. ;
  1. ; add/update entry in file 347 for reports
  1. N %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
  1. S DA347=$O(^RC(347,"C",$P(RESULT,"^",2),0))
  1. ; if not in the file, addit fmsdocid sv id
  1. I 'DA347 D OPEN^RCFMDRV1($P(RESULT,"^",2),4,"SV-"_$E(RCDATEND,1,5)_"00",.DA347,.ERROR)
  1. I DA347 D SSTAT^RCFMFN02($P(RESULT,"^",2),1)
  1. Q
  1. ;
  1. ;
  1. BUILDSV(RCDATEND,RCGECSDA,RCTRANID,RCKS) ; generate a wr code sheet for monthly data
  1. ; rcgecsda is the ien for the gcs stack file 2100.1 for rebuilds
  1. ; data stored in tmp($j,rcrjrcolsv)
  1. ; rcks is the "key suffix" to distinguish the gecs lookup key
  1. ; for the SRB SV from the lookup key for the BDR SV
  1. ;
  1. N AMOUNT,COUNT,DESCRIP,DOCTOTAL,FISCALYR,FMSLINE,FUND,FY,GECSFMS,MONTH,REVDATE,REVFY,REVMONTH,RSC,SV2,TYPE,FMAMOUNT
  1. ;
  1. S FISCALYR=$$FY^RCFN01(RCDATEND)
  1. ;
  1. S COUNT=0,DOCTOTAL=0
  1. S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLSV",TYPE)) Q:TYPE="" D
  1. . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND)) Q:FUND="" D
  1. . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND,RSC)) Q:RSC="" D
  1. . . . S AMOUNT=^TMP($J,"RCRJRCOLSV",TYPE,FUND,RSC),DOCTOTAL=DOCTOTAL+AMOUNT
  1. . . . I +AMOUNT=0 Q
  1. . . . S COUNT=COUNT+1
  1. . . . S FMSLINE(COUNT)="LIN^~SVA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
  1. . . . S $P(FMSLINE(COUNT),"^",4)=TYPE
  1. . . . S $P(FMSLINE(COUNT),"^",5)=FISCALYR ;begin fy
  1. . . . I $E(FUND,1,4)=5287 S $P(FMSLINE(COUNT),"^",5)="05"
  1. . . . S $P(FMSLINE(COUNT),"^",7)=FUND
  1. . . . S $P(FMSLINE(COUNT),"^",9)=$E(RCTRANID,1,3) ;site number
  1. . . . ; for transaction types 23,27,2B the RSC is 0, send null
  1. . . . S $P(FMSLINE(COUNT),"^",14)=$S(RSC=0:"",1:RSC)
  1. . . . ;
  1. . . . ; vendor id
  1. . . . S $P(FMSLINE(COUNT),"^",18)="MCCFVALUE"
  1. . . . ; for transaction type P2, send vendorid of PERSONOTH
  1. . . . I TYPE="P2" S $P(FMSLINE(COUNT),"^",18)="PERSONOTH"
  1. . . . ; if it is hsif fund 5358.1, send vendorid of HSIFVALUE
  1. . . . I FUND=5358.1 S $P(FMSLINE(COUNT),"^",18)="HSIFVALUE"
  1. . . . ; if it is ltc fund 4032 or 528709, send vendorid of EXCFVALUE
  1. . . . I FUND=4032!(FUND=528709) D
  1. . . . . S $P(FMSLINE(COUNT),"^",18)="EXCFVALUE"
  1. . . . . S:FUND=4032 $P(FMSLINE(COUNT),"^",5)="03" ; FY
  1. . . . . S:$E(FUND,1,4)=5287 $P(FMSLINE(COUNT),"^",5)="05" ; FY
  1. . . . ;
  1. . . . ; send pos figure to FMS; neg amt requires a "D"
  1. . . . S FMAMOUNT=$S(AMOUNT<0:-AMOUNT,1:AMOUNT)
  1. . . . S $P(FMSLINE(COUNT),"^",19)="~SVB"
  1. . . . S $P(FMSLINE(COUNT),"^",20)=$J(FMAMOUNT,0,2)
  1. . . . S $P(FMSLINE(COUNT),"^",21)=$S(AMOUNT<0:"D",1:"I")
  1. . . . ; for transaction types 23,27,2B the RSC is 0, send G
  1. . . . S $P(FMSLINE(COUNT),"^",23)=$S(RSC=0:"G",1:"R")
  1. . . . S $P(FMSLINE(COUNT),"^",25)=$E(RCDATEND,2,3)
  1. . . . S $P(FMSLINE(COUNT),"^",26)=$E(RCDATEND,4,5)
  1. . . . S $P(FMSLINE(COUNT),"^",27)=$E(RCDATEND,6,7)
  1. . . . S $P(FMSLINE(COUNT),"^",28)="~"
  1. ;
  1. ; no code sheets to send
  1. I COUNT=0 Q "0^No sv code sheets to send for this month"
  1. ;
  1. ; calculate the accounting month and fy
  1. S FY=$E(RCDATEND,2,3) I $E(RCDATEND,4,5)>9 S FY=FY+1 I FY=100 S FY="00"
  1. I $L(FY)=1 S FY="0"_FY
  1. S MONTH=$P("04^05^06^07^08^09^10^11^12^01^02^03","^",$E(RCDATEND,4,5))
  1. ; calculate the reversal month and fy (next month, add 1 day)
  1. S REVDATE=$$FMADD^XLFDT(RCDATEND,9)
  1. S REVFY=$E(REVDATE,2,3) I $E(REVDATE,4,5)>9 S REVFY=REVFY+1 I REVFY=100 S REVFY="00"
  1. I $L(REVFY)=1 S REVFY="0"_REVFY
  1. S REVMONTH=$P("04^05^06^07^08^09^10^11^12^01^02^03","^",$E(REVDATE,4,5))
  1. ;
  1. S SV2="SV2^"_$E(RCDATEND,2,3)_"^"_$E(RCDATEND,4,5)_"^"_$E(RCDATEND,6,7)
  1. S $P(SV2,"^",5)=MONTH ;accounting period month
  1. S $P(SV2,"^",6)=FY ;accounting period year
  1. S $P(SV2,"^",7)="E"
  1. S $P(SV2,"^",12)=REVFY ;reversal period year
  1. S $P(SV2,"^",13)=REVMONTH ;reversal period month
  1. S:DOCTOTAL<0 DOCTOTAL=-DOCTOTAL ; document total must be positive
  1. S $P(SV2,"^",16)=$J(DOCTOTAL,0,2)_"^~"
  1. ;
  1. ; put together document in gcs
  1. N %DT,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
  1. S Y=$E(RCDATEND,1,5)_"00" D DD^%DT
  1. S DESCRIP="Monthly Standard Voucher for "_Y
  1. I 'RCGECSDA D CONTROL^GECSUFMS("A",$E(RCTRANID,1,3),RCTRANID,"SV",10,0,"",DESCRIP)
  1. I RCGECSDA D REBUILD^GECSUFM1(RCGECSDA,"A",10,"","Rebuild "_DESCRIP) S GECSFMS("DA")=RCGECSDA
  1. ;
  1. ; store document in gcs
  1. D SETCS^GECSSTAA(GECSFMS("DA"),SV2)
  1. F COUNT=1:1 Q:'$D(FMSLINE(COUNT)) D SETCS^GECSSTAA(GECSFMS("DA"),FMSLINE(COUNT))
  1. D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
  1. D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
  1. ; set the key for lookup
  1. D SETKEY^GECSSTAA(GECSFMS("DA"),"SV-"_$E(RCDATEND,1,5)_RCKS)
  1. ;
  1. ; return 1 for success ^ fms document transaction number
  1. Q "1^SV-"_$P(GECSFMS("CTL"),"^",9)
  1. ;
  1. ;
  1. BADDEBT(RCRJDATE) ; top entry point to generate a sv code sheet
  1. ; for the bad debt report, transaction types 23, 27, 2B and 2J.
  1. ; The fms document number in file 347 is SV-$e(dateend,1,5)_"01"
  1. ;
  1. ; Input: RCRJDATE -- last day of accounting month
  1. ;
  1. N DATA1319,DATA1338,DATA1339,DATA4032,DATAHSIF,GECSDATA,RESULT,RCRJFMM,RCRJFXSV,RCTRANID,X,RCNOHSIF,LTCFUND,DATA133M,DATA133T
  1. N DATA133N,DATA133Q,DATA133R,DATA133S
  1. ;
  1. S RCNOHSIF=$$NOHSIF^RCRJRCO() ; disabled HSIF
  1. ;
  1. ; lock cannot fail
  1. L +^RC(348.1)
  1. ;
  1. ; get the data from the bad debt allowance file 348.1
  1. K ^TMP($J,"RCRJRCOLSV")
  1. S DATA1319=$G(^RC(348.1,+$O(^RC(348.1,"B",1319,0)),0))
  1. S DATA1338=$G(^RC(348.1,+$O(^RC(348.1,"B",1338,0)),0))
  1. S DATA1339=$G(^RC(348.1,+$O(^RC(348.1,"B",1339,0)),0))
  1. S DATA133N=$G(^RC(348.1,+$O(^RC(348.1,"B","133N",0)),0))
  1. I 'RCNOHSIF S DATAHSIF=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.1,0)),0))
  1. S DATA4032=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.2,0)),0))
  1. S DATA133M=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.3,0)),0))
  1. S DATA133T=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.4,0)),0))
  1. S DATA133Q=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.5,0)),0))
  1. S DATA133R=$G(^RC(348.1,+$O(^RC(348.1,"B","133N.2",0)),0))
  1. S DATA133S=$G(^RC(348.1,+$O(^RC(348.1,"B",1338.2,0)),0))
  1. ;
  1. ;PRCA*4.5*357 - add missing SGLS to report
  1. S DATA13N3=$G(^RC(348.1,+$O(^RC(348.1,"B","133N.3",0)),0)) ;1339.N3
  1. S DATA1396=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.6,0)),0)) ;1319.6
  1. S DATA1397=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.7,0)),0)) ;1319.7
  1. S DATA1398=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.8,0)),0)) ;1319.8
  1. S DATA1399=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.9,0)),0)) ;1319.9
  1. S DATA1383=$G(^RC(348.1,+$O(^RC(348.1,"B",1338.3,0)),0)) ;1338.3
  1. S DATA1391=$G(^RC(348.1,+$O(^RC(348.1,"B",1339.1,0)),0)) ;1339.1
  1. ;end PRCA*4.5*357
  1. ;
  1. ;
  1. ; the revenue source code here is a 0
  1. ;23
  1. S ^TMP($J,"RCRJRCOLSV","23",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.3,1:528703)),0)=$P(DATA1319,"^",8)
  1. I 'RCNOHSIF S ^TMP($J,"RCRJRCOLSV","23",5358.1,0)=$P(DATAHSIF,"^",8)
  1. ;patch 220 replaces 4032 fund with 528709
  1. S LTCFUND=$S(DT'<$$ADDPTEDT^PRCAACC():528709,1:4032)
  1. S ^TMP($J,"RCRJRCOLSV","23",LTCFUND,0)=$P(DATA4032,"^",8)
  1. S ^TMP($J,"RCRJRCOLSV","23",528701,0)=$P(DATA133M,"^",8)
  1. S ^TMP($J,"RCRJRCOLSV","23",528704,0)=$P(DATA133T,"^",8)
  1. S ^TMP($J,"RCRJRCOLSV","23",528711,0)=$P(DATA133Q,"^",8)
  1. S ^TMP($J,"RCRJRCOLSV","23",528713,0)=$P(DATA1396,"^",8)
  1. S ^TMP($J,"RCRJRCOLSV","23",528714,0)=$P(DATA1397,"^",8)+$P(DATA1398,"^",8)+$P(DATA1399,"^",8)
  1. ;27
  1. S ^TMP($J,"RCRJRCOLSV","27",528713,0)=$P(DATA1391,"^",8)
  1. ;2J
  1. S ^TMP($J,"RCRJRCOLSV","2J",528711,0)=$P(DATA133R,"^",8)
  1. S ^TMP($J,"RCRJRCOLSV","2J",528713,0)=$P(DATA13N3,"^",8)
  1. ;2B
  1. S ^TMP($J,"RCRJRCOLSV","2B",528711,0)=$P(DATA133S,"^",8)
  1. S ^TMP($J,"RCRJRCOLSV","2B",528713,0)=$P(DATA1383,"^",8)
  1. ;
  1. ;Pre MRA funds
  1. S ^TMP($J,"RCRJRCOLSV","2B",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$P(DATA1338,"^",8)
  1. S ^TMP($J,"RCRJRCOLSV","27",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$P(DATA1339,"^",8)
  1. ; post-MRA non-Medicare bills
  1. S ^TMP($J,"RCRJRCOLSV","2J",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$P(DATA133N,"^",8)
  1. ;
  1. ; the date is for previous month
  1. ;S RCRJDATE=$$PREVMONT^RCRJRBD(DT)
  1. ;I $E(DT,6,7)<$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$$PREVMONT^RCRJRBD(DT)
  1. ;I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$E($$LDATE^RCRJR(DT),1,5)_"00"
  1. ;I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$$LDATE^RCRJR(DT)
  1. ; find the last day of the month for the end date
  1. ;S RCRJDATE=$E(RCRJDATE,1,5)_$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(RCRJDATE,4,5))
  1. ;I $E(RCRJDATE,6,7)=28,$E(RCRJDATE,2,3)#4=0 S RCRJDATE=$E(RCRJDATE,1,5)_"29"
  1. ;
  1. ; lookup fms document number to see if the monthly sv has been sent
  1. ; example rcdatend=3010531, lookup on 3010501
  1. D KEYLOOK^GECSSGET("SV-"_$E(RCRJDATE,1,5)_"01",1)
  1. ;
  1. ; get the transacion id for the fms document
  1. ; if it is not sent, get the next number available
  1. I $G(GECSDATA) S RCTRANID=$E($P(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
  1. I $G(RCTRANID)="" S RCTRANID=$$ENUM^RCMSNUM
  1. I RCTRANID<0 Q ;unable to retrieve the next number
  1. ; remove dash (example 460-K1A05HY)
  1. S RCTRANID=$TR(RCTRANID,"-")
  1. ;
  1. ; build and send the sv document to fms
  1. S RESULT=$$BUILDSV(RCRJDATE,+$G(GECSDATA),RCTRANID,"01")
  1. K ^TMP($J,"RCRJRCOLSV")
  1. ; error in building code sheet
  1. I 'RESULT D Q Q
  1. ;
  1. ; add/update entry in file 347 for reports
  1. N %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
  1. S DA347=$O(^RC(347,"D","SV-"_$E(RCRJDATE,1,5)_"01",0))
  1. ; if not in the file, addit fmsdocid sv id
  1. I 'DA347 D OPEN^RCFMDRV1($P(RESULT,"^",2),4,"SV-"_$E(RCRJDATE,1,5)_"01",.DA347,.ERROR)
  1. I DA347 D SSTAT^RCFMFN02($P(RESULT,"^",2),1)
  1. ;
  1. Q ; jump here to finish
  1. ; generate bad debt report
  1. S RCRJFXSV=$P(RESULT,"^",2),RCRJFMM=1 D DQ^RCRJRBDR
  1. L -^RC(348.1)
  1. Q