- RCXFMSSV ;WISC/RFJ-fms standard voucher (sv) code sheet generator ; 9/7/10 7:43am
- ;;4.5;Accounts Receivable;**96,101,135,139,98,156,170,191,203,220,138,184,239,273,357**;Mar 20, 1995;Build 6
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- Q
- ;
- ;
- STARTSV(RCDATEND) ; top entry point to generate a sv code sheet
- ;
- ; rcdatend is the ending date of the period.
- ; This date is the 3rd work day from the end of the month.
- ; The utility $$LDATE^RCRJR is used to figure it out. It will
- ; change from month to month and figures in holidays also.
- ; For example, if running the ARDC for the month of June 2003
- ; the EOAM will calculate out to be June 25, 2003.
- ; This is called by the background monthly data collector
- ;
- ; data stored in tmp($j,rcrjrcolsv,type,fund,revsourcecode)
- ; this is called by the background monthly data collector
- ;
- N GECSDATA,RCTRANID,RESULT
- ; lookup fms document number to see if the monthly sv has been sent
- ; example rcdatend=3010531, lookup on 3010500
- D KEYLOOK^GECSSGET("SV-"_$E(RCDATEND,1,5)_"00",1)
- ;
- ; get the transacion id for the fms document
- ; if it is not sent, get the next number available
- I $G(GECSDATA) S RCTRANID=$E($P(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
- I $G(RCTRANID)="" S RCTRANID=$$ENUM^RCMSNUM
- I RCTRANID<0 Q ;unable to retrieve the next number
- ; remove dash (example 460-K1A05HY)
- S RCTRANID=$TR(RCTRANID,"-")
- ;
- ; build and send the sv document to fms
- S RESULT=$$BUILDSV(RCDATEND,+$G(GECSDATA),RCTRANID,"00")
- ; error in building code sheet
- I 'RESULT Q
- ;
- ; add/update entry in file 347 for reports
- N %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
- S DA347=$O(^RC(347,"C",$P(RESULT,"^",2),0))
- ; if not in the file, addit fmsdocid sv id
- I 'DA347 D OPEN^RCFMDRV1($P(RESULT,"^",2),4,"SV-"_$E(RCDATEND,1,5)_"00",.DA347,.ERROR)
- I DA347 D SSTAT^RCFMFN02($P(RESULT,"^",2),1)
- Q
- ;
- ;
- BUILDSV(RCDATEND,RCGECSDA,RCTRANID,RCKS) ; generate a wr code sheet for monthly data
- ; rcgecsda is the ien for the gcs stack file 2100.1 for rebuilds
- ; data stored in tmp($j,rcrjrcolsv)
- ; rcks is the "key suffix" to distinguish the gecs lookup key
- ; for the SRB SV from the lookup key for the BDR SV
- ;
- N AMOUNT,COUNT,DESCRIP,DOCTOTAL,FISCALYR,FMSLINE,FUND,FY,GECSFMS,MONTH,REVDATE,REVFY,REVMONTH,RSC,SV2,TYPE,FMAMOUNT
- ;
- S FISCALYR=$$FY^RCFN01(RCDATEND)
- ;
- S COUNT=0,DOCTOTAL=0
- S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLSV",TYPE)) Q:TYPE="" D
- . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND)) Q:FUND="" D
- . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND,RSC)) Q:RSC="" D
- . . . S AMOUNT=^TMP($J,"RCRJRCOLSV",TYPE,FUND,RSC),DOCTOTAL=DOCTOTAL+AMOUNT
- . . . I +AMOUNT=0 Q
- . . . S COUNT=COUNT+1
- . . . S FMSLINE(COUNT)="LIN^~SVA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
- . . . S $P(FMSLINE(COUNT),"^",4)=TYPE
- . . . S $P(FMSLINE(COUNT),"^",5)=FISCALYR ;begin fy
- . . . I $E(FUND,1,4)=5287 S $P(FMSLINE(COUNT),"^",5)="05"
- . . . S $P(FMSLINE(COUNT),"^",7)=FUND
- . . . S $P(FMSLINE(COUNT),"^",9)=$E(RCTRANID,1,3) ;site number
- . . . ; for transaction types 23,27,2B the RSC is 0, send null
- . . . S $P(FMSLINE(COUNT),"^",14)=$S(RSC=0:"",1:RSC)
- . . . ;
- . . . ; vendor id
- . . . S $P(FMSLINE(COUNT),"^",18)="MCCFVALUE"
- . . . ; for transaction type P2, send vendorid of PERSONOTH
- . . . I TYPE="P2" S $P(FMSLINE(COUNT),"^",18)="PERSONOTH"
- . . . ; if it is hsif fund 5358.1, send vendorid of HSIFVALUE
- . . . I FUND=5358.1 S $P(FMSLINE(COUNT),"^",18)="HSIFVALUE"
- . . . ; if it is ltc fund 4032 or 528709, send vendorid of EXCFVALUE
- . . . I FUND=4032!(FUND=528709) D
- . . . . S $P(FMSLINE(COUNT),"^",18)="EXCFVALUE"
- . . . . S:FUND=4032 $P(FMSLINE(COUNT),"^",5)="03" ; FY
- . . . . S:$E(FUND,1,4)=5287 $P(FMSLINE(COUNT),"^",5)="05" ; FY
- . . . ;
- . . . ; send pos figure to FMS; neg amt requires a "D"
- . . . S FMAMOUNT=$S(AMOUNT<0:-AMOUNT,1:AMOUNT)
- . . . S $P(FMSLINE(COUNT),"^",19)="~SVB"
- . . . S $P(FMSLINE(COUNT),"^",20)=$J(FMAMOUNT,0,2)
- . . . S $P(FMSLINE(COUNT),"^",21)=$S(AMOUNT<0:"D",1:"I")
- . . . ; for transaction types 23,27,2B the RSC is 0, send G
- . . . S $P(FMSLINE(COUNT),"^",23)=$S(RSC=0:"G",1:"R")
- . . . S $P(FMSLINE(COUNT),"^",25)=$E(RCDATEND,2,3)
- . . . S $P(FMSLINE(COUNT),"^",26)=$E(RCDATEND,4,5)
- . . . S $P(FMSLINE(COUNT),"^",27)=$E(RCDATEND,6,7)
- . . . S $P(FMSLINE(COUNT),"^",28)="~"
- ;
- ; no code sheets to send
- I COUNT=0 Q "0^No sv code sheets to send for this month"
- ;
- ; calculate the accounting month and fy
- S FY=$E(RCDATEND,2,3) I $E(RCDATEND,4,5)>9 S FY=FY+1 I FY=100 S FY="00"
- I $L(FY)=1 S FY="0"_FY
- S MONTH=$P("04^05^06^07^08^09^10^11^12^01^02^03","^",$E(RCDATEND,4,5))
- ; calculate the reversal month and fy (next month, add 1 day)
- S REVDATE=$$FMADD^XLFDT(RCDATEND,9)
- S REVFY=$E(REVDATE,2,3) I $E(REVDATE,4,5)>9 S REVFY=REVFY+1 I REVFY=100 S REVFY="00"
- I $L(REVFY)=1 S REVFY="0"_REVFY
- S REVMONTH=$P("04^05^06^07^08^09^10^11^12^01^02^03","^",$E(REVDATE,4,5))
- ;
- S SV2="SV2^"_$E(RCDATEND,2,3)_"^"_$E(RCDATEND,4,5)_"^"_$E(RCDATEND,6,7)
- S $P(SV2,"^",5)=MONTH ;accounting period month
- S $P(SV2,"^",6)=FY ;accounting period year
- S $P(SV2,"^",7)="E"
- S $P(SV2,"^",12)=REVFY ;reversal period year
- S $P(SV2,"^",13)=REVMONTH ;reversal period month
- S:DOCTOTAL<0 DOCTOTAL=-DOCTOTAL ; document total must be positive
- S $P(SV2,"^",16)=$J(DOCTOTAL,0,2)_"^~"
- ;
- ; put together document in gcs
- N %DT,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
- S Y=$E(RCDATEND,1,5)_"00" D DD^%DT
- S DESCRIP="Monthly Standard Voucher for "_Y
- I 'RCGECSDA D CONTROL^GECSUFMS("A",$E(RCTRANID,1,3),RCTRANID,"SV",10,0,"",DESCRIP)
- I RCGECSDA D REBUILD^GECSUFM1(RCGECSDA,"A",10,"","Rebuild "_DESCRIP) S GECSFMS("DA")=RCGECSDA
- ;
- ; store document in gcs
- D SETCS^GECSSTAA(GECSFMS("DA"),SV2)
- F COUNT=1:1 Q:'$D(FMSLINE(COUNT)) D SETCS^GECSSTAA(GECSFMS("DA"),FMSLINE(COUNT))
- D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
- D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
- ; set the key for lookup
- D SETKEY^GECSSTAA(GECSFMS("DA"),"SV-"_$E(RCDATEND,1,5)_RCKS)
- ;
- ; return 1 for success ^ fms document transaction number
- Q "1^SV-"_$P(GECSFMS("CTL"),"^",9)
- ;
- ;
- BADDEBT(RCRJDATE) ; top entry point to generate a sv code sheet
- ; for the bad debt report, transaction types 23, 27, 2B and 2J.
- ; The fms document number in file 347 is SV-$e(dateend,1,5)_"01"
- ;
- ; Input: RCRJDATE -- last day of accounting month
- ;
- N DATA1319,DATA1338,DATA1339,DATA4032,DATAHSIF,GECSDATA,RESULT,RCRJFMM,RCRJFXSV,RCTRANID,X,RCNOHSIF,LTCFUND,DATA133M,DATA133T
- N DATA133N,DATA133Q,DATA133R,DATA133S
- ;
- S RCNOHSIF=$$NOHSIF^RCRJRCO() ; disabled HSIF
- ;
- ; lock cannot fail
- L +^RC(348.1)
- ;
- ; get the data from the bad debt allowance file 348.1
- K ^TMP($J,"RCRJRCOLSV")
- S DATA1319=$G(^RC(348.1,+$O(^RC(348.1,"B",1319,0)),0))
- S DATA1338=$G(^RC(348.1,+$O(^RC(348.1,"B",1338,0)),0))
- S DATA1339=$G(^RC(348.1,+$O(^RC(348.1,"B",1339,0)),0))
- S DATA133N=$G(^RC(348.1,+$O(^RC(348.1,"B","133N",0)),0))
- I 'RCNOHSIF S DATAHSIF=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.1,0)),0))
- S DATA4032=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.2,0)),0))
- S DATA133M=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.3,0)),0))
- S DATA133T=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.4,0)),0))
- S DATA133Q=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.5,0)),0))
- S DATA133R=$G(^RC(348.1,+$O(^RC(348.1,"B","133N.2",0)),0))
- S DATA133S=$G(^RC(348.1,+$O(^RC(348.1,"B",1338.2,0)),0))
- ;
- ;PRCA*4.5*357 - add missing SGLS to report
- S DATA13N3=$G(^RC(348.1,+$O(^RC(348.1,"B","133N.3",0)),0)) ;1339.N3
- S DATA1396=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.6,0)),0)) ;1319.6
- S DATA1397=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.7,0)),0)) ;1319.7
- S DATA1398=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.8,0)),0)) ;1319.8
- S DATA1399=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.9,0)),0)) ;1319.9
- S DATA1383=$G(^RC(348.1,+$O(^RC(348.1,"B",1338.3,0)),0)) ;1338.3
- S DATA1391=$G(^RC(348.1,+$O(^RC(348.1,"B",1339.1,0)),0)) ;1339.1
- ;end PRCA*4.5*357
- ;
- ;
- ; the revenue source code here is a 0
- ;23
- S ^TMP($J,"RCRJRCOLSV","23",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.3,1:528703)),0)=$P(DATA1319,"^",8)
- I 'RCNOHSIF S ^TMP($J,"RCRJRCOLSV","23",5358.1,0)=$P(DATAHSIF,"^",8)
- ;patch 220 replaces 4032 fund with 528709
- S LTCFUND=$S(DT'<$$ADDPTEDT^PRCAACC():528709,1:4032)
- S ^TMP($J,"RCRJRCOLSV","23",LTCFUND,0)=$P(DATA4032,"^",8)
- S ^TMP($J,"RCRJRCOLSV","23",528701,0)=$P(DATA133M,"^",8)
- S ^TMP($J,"RCRJRCOLSV","23",528704,0)=$P(DATA133T,"^",8)
- S ^TMP($J,"RCRJRCOLSV","23",528711,0)=$P(DATA133Q,"^",8)
- S ^TMP($J,"RCRJRCOLSV","23",528713,0)=$P(DATA1396,"^",8)
- S ^TMP($J,"RCRJRCOLSV","23",528714,0)=$P(DATA1397,"^",8)+$P(DATA1398,"^",8)+$P(DATA1399,"^",8)
- ;27
- S ^TMP($J,"RCRJRCOLSV","27",528713,0)=$P(DATA1391,"^",8)
- ;2J
- S ^TMP($J,"RCRJRCOLSV","2J",528711,0)=$P(DATA133R,"^",8)
- S ^TMP($J,"RCRJRCOLSV","2J",528713,0)=$P(DATA13N3,"^",8)
- ;2B
- S ^TMP($J,"RCRJRCOLSV","2B",528711,0)=$P(DATA133S,"^",8)
- S ^TMP($J,"RCRJRCOLSV","2B",528713,0)=$P(DATA1383,"^",8)
- ;
- ;Pre MRA funds
- S ^TMP($J,"RCRJRCOLSV","2B",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$P(DATA1338,"^",8)
- S ^TMP($J,"RCRJRCOLSV","27",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$P(DATA1339,"^",8)
- ; post-MRA non-Medicare bills
- S ^TMP($J,"RCRJRCOLSV","2J",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$P(DATA133N,"^",8)
- ;
- ; the date is for previous month
- ;S RCRJDATE=$$PREVMONT^RCRJRBD(DT)
- ;I $E(DT,6,7)<$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$$PREVMONT^RCRJRBD(DT)
- ;I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$E($$LDATE^RCRJR(DT),1,5)_"00"
- ;I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$$LDATE^RCRJR(DT)
- ; find the last day of the month for the end date
- ;S RCRJDATE=$E(RCRJDATE,1,5)_$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(RCRJDATE,4,5))
- ;I $E(RCRJDATE,6,7)=28,$E(RCRJDATE,2,3)#4=0 S RCRJDATE=$E(RCRJDATE,1,5)_"29"
- ;
- ; lookup fms document number to see if the monthly sv has been sent
- ; example rcdatend=3010531, lookup on 3010501
- D KEYLOOK^GECSSGET("SV-"_$E(RCRJDATE,1,5)_"01",1)
- ;
- ; get the transacion id for the fms document
- ; if it is not sent, get the next number available
- I $G(GECSDATA) S RCTRANID=$E($P(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
- I $G(RCTRANID)="" S RCTRANID=$$ENUM^RCMSNUM
- I RCTRANID<0 Q ;unable to retrieve the next number
- ; remove dash (example 460-K1A05HY)
- S RCTRANID=$TR(RCTRANID,"-")
- ;
- ; build and send the sv document to fms
- S RESULT=$$BUILDSV(RCRJDATE,+$G(GECSDATA),RCTRANID,"01")
- K ^TMP($J,"RCRJRCOLSV")
- ; error in building code sheet
- I 'RESULT D Q Q
- ;
- ; add/update entry in file 347 for reports
- N %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
- S DA347=$O(^RC(347,"D","SV-"_$E(RCRJDATE,1,5)_"01",0))
- ; if not in the file, addit fmsdocid sv id
- I 'DA347 D OPEN^RCFMDRV1($P(RESULT,"^",2),4,"SV-"_$E(RCRJDATE,1,5)_"01",.DA347,.ERROR)
- I DA347 D SSTAT^RCFMFN02($P(RESULT,"^",2),1)
- ;
- Q ; jump here to finish
- ; generate bad debt report
- S RCRJFXSV=$P(RESULT,"^",2),RCRJFMM=1 D DQ^RCRJRBDR
- L -^RC(348.1)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXFMSSV 11272 printed Jan 18, 2025@02:50:30 Page 2
- 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
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- STARTSV(RCDATEND) ; top entry point to generate a sv code sheet
- +1 ;
- +2 ; rcdatend is the ending date of the period.
- +3 ; This date is the 3rd work day from the end of the month.
- +4 ; The utility $$LDATE^RCRJR is used to figure it out. It will
- +5 ; change from month to month and figures in holidays also.
- +6 ; For example, if running the ARDC for the month of June 2003
- +7 ; the EOAM will calculate out to be June 25, 2003.
- +8 ; This is called by the background monthly data collector
- +9 ;
- +10 ; data stored in tmp($j,rcrjrcolsv,type,fund,revsourcecode)
- +11 ; this is called by the background monthly data collector
- +12 ;
- +13 NEW GECSDATA,RCTRANID,RESULT
- +14 ; lookup fms document number to see if the monthly sv has been sent
- +15 ; example rcdatend=3010531, lookup on 3010500
- +16 DO KEYLOOK^GECSSGET("SV-"_$EXTRACT(RCDATEND,1,5)_"00",1)
- +17 ;
- +18 ; get the transacion id for the fms document
- +19 ; if it is not sent, get the next number available
- +20 IF $GET(GECSDATA)
- SET RCTRANID=$EXTRACT($PIECE(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
- +21 IF $GET(RCTRANID)=""
- SET RCTRANID=$$ENUM^RCMSNUM
- +22 ;unable to retrieve the next number
- IF RCTRANID<0
- QUIT
- +23 ; remove dash (example 460-K1A05HY)
- +24 SET RCTRANID=$TRANSLATE(RCTRANID,"-")
- +25 ;
- +26 ; build and send the sv document to fms
- +27 SET RESULT=$$BUILDSV(RCDATEND,+$GET(GECSDATA),RCTRANID,"00")
- +28 ; error in building code sheet
- +29 IF 'RESULT
- QUIT
- +30 ;
- +31 ; add/update entry in file 347 for reports
- +32 NEW %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
- +33 SET DA347=$ORDER(^RC(347,"C",$PIECE(RESULT,"^",2),0))
- +34 ; if not in the file, addit fmsdocid sv id
- +35 IF 'DA347
- DO OPEN^RCFMDRV1($PIECE(RESULT,"^",2),4,"SV-"_$EXTRACT(RCDATEND,1,5)_"00",.DA347,.ERROR)
- +36 IF DA347
- DO SSTAT^RCFMFN02($PIECE(RESULT,"^",2),1)
- +37 QUIT
- +38 ;
- +39 ;
- 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
- +2 ; data stored in tmp($j,rcrjrcolsv)
- +3 ; rcks is the "key suffix" to distinguish the gecs lookup key
- +4 ; for the SRB SV from the lookup key for the BDR SV
- +5 ;
- +6 NEW AMOUNT,COUNT,DESCRIP,DOCTOTAL,FISCALYR,FMSLINE,FUND,FY,GECSFMS,MONTH,REVDATE,REVFY,REVMONTH,RSC,SV2,TYPE,FMAMOUNT
- +7 ;
- +8 SET FISCALYR=$$FY^RCFN01(RCDATEND)
- +9 ;
- +10 SET COUNT=0
- SET DOCTOTAL=0
- +11 SET TYPE=""
- FOR
- SET TYPE=$ORDER(^TMP($JOB,"RCRJRCOLSV",TYPE))
- if TYPE=""
- QUIT
- Begin DoDot:1
- +12 SET FUND=""
- FOR
- SET FUND=$ORDER(^TMP($JOB,"RCRJRCOLSV",TYPE,FUND))
- if FUND=""
- QUIT
- Begin DoDot:2
- +13 SET RSC=""
- FOR
- SET RSC=$ORDER(^TMP($JOB,"RCRJRCOLSV",TYPE,FUND,RSC))
- if RSC=""
- QUIT
- Begin DoDot:3
- +14 SET AMOUNT=^TMP($JOB,"RCRJRCOLSV",TYPE,FUND,RSC)
- SET DOCTOTAL=DOCTOTAL+AMOUNT
- +15 IF +AMOUNT=0
- QUIT
- +16 SET COUNT=COUNT+1
- +17 SET FMSLINE(COUNT)="LIN^~SVA^"_$SELECT($LENGTH(COUNT)=1:"00",$LENGTH(COUNT)=2:"0",1:"")_COUNT
- +18 SET $PIECE(FMSLINE(COUNT),"^",4)=TYPE
- +19 ;begin fy
- SET $PIECE(FMSLINE(COUNT),"^",5)=FISCALYR
- +20 IF $EXTRACT(FUND,1,4)=5287
- SET $PIECE(FMSLINE(COUNT),"^",5)="05"
- +21 SET $PIECE(FMSLINE(COUNT),"^",7)=FUND
- +22 ;site number
- SET $PIECE(FMSLINE(COUNT),"^",9)=$EXTRACT(RCTRANID,1,3)
- +23 ; for transaction types 23,27,2B the RSC is 0, send null
- +24 SET $PIECE(FMSLINE(COUNT),"^",14)=$SELECT(RSC=0:"",1:RSC)
- +25 ;
- +26 ; vendor id
- +27 SET $PIECE(FMSLINE(COUNT),"^",18)="MCCFVALUE"
- +28 ; for transaction type P2, send vendorid of PERSONOTH
- +29 IF TYPE="P2"
- SET $PIECE(FMSLINE(COUNT),"^",18)="PERSONOTH"
- +30 ; if it is hsif fund 5358.1, send vendorid of HSIFVALUE
- +31 IF FUND=5358.1
- SET $PIECE(FMSLINE(COUNT),"^",18)="HSIFVALUE"
- +32 ; if it is ltc fund 4032 or 528709, send vendorid of EXCFVALUE
- +33 IF FUND=4032!(FUND=528709)
- Begin DoDot:4
- +34 SET $PIECE(FMSLINE(COUNT),"^",18)="EXCFVALUE"
- +35 ; FY
- if FUND=4032
- SET $PIECE(FMSLINE(COUNT),"^",5)="03"
- +36 ; FY
- if $EXTRACT(FUND,1,4)=5287
- SET $PIECE(FMSLINE(COUNT),"^",5)="05"
- End DoDot:4
- +37 ;
- +38 ; send pos figure to FMS; neg amt requires a "D"
- +39 SET FMAMOUNT=$SELECT(AMOUNT<0:-AMOUNT,1:AMOUNT)
- +40 SET $PIECE(FMSLINE(COUNT),"^",19)="~SVB"
- +41 SET $PIECE(FMSLINE(COUNT),"^",20)=$JUSTIFY(FMAMOUNT,0,2)
- +42 SET $PIECE(FMSLINE(COUNT),"^",21)=$SELECT(AMOUNT<0:"D",1:"I")
- +43 ; for transaction types 23,27,2B the RSC is 0, send G
- +44 SET $PIECE(FMSLINE(COUNT),"^",23)=$SELECT(RSC=0:"G",1:"R")
- +45 SET $PIECE(FMSLINE(COUNT),"^",25)=$EXTRACT(RCDATEND,2,3)
- +46 SET $PIECE(FMSLINE(COUNT),"^",26)=$EXTRACT(RCDATEND,4,5)
- +47 SET $PIECE(FMSLINE(COUNT),"^",27)=$EXTRACT(RCDATEND,6,7)
- +48 SET $PIECE(FMSLINE(COUNT),"^",28)="~"
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +49 ;
- +50 ; no code sheets to send
- +51 IF COUNT=0
- QUIT "0^No sv code sheets to send for this month"
- +52 ;
- +53 ; calculate the accounting month and fy
- +54 SET FY=$EXTRACT(RCDATEND,2,3)
- IF $EXTRACT(RCDATEND,4,5)>9
- SET FY=FY+1
- IF FY=100
- SET FY="00"
- +55 IF $LENGTH(FY)=1
- SET FY="0"_FY
- +56 SET MONTH=$PIECE("04^05^06^07^08^09^10^11^12^01^02^03","^",$EXTRACT(RCDATEND,4,5))
- +57 ; calculate the reversal month and fy (next month, add 1 day)
- +58 SET REVDATE=$$FMADD^XLFDT(RCDATEND,9)
- +59 SET REVFY=$EXTRACT(REVDATE,2,3)
- IF $EXTRACT(REVDATE,4,5)>9
- SET REVFY=REVFY+1
- IF REVFY=100
- SET REVFY="00"
- +60 IF $LENGTH(REVFY)=1
- SET REVFY="0"_REVFY
- +61 SET REVMONTH=$PIECE("04^05^06^07^08^09^10^11^12^01^02^03","^",$EXTRACT(REVDATE,4,5))
- +62 ;
- +63 SET SV2="SV2^"_$EXTRACT(RCDATEND,2,3)_"^"_$EXTRACT(RCDATEND,4,5)_"^"_$EXTRACT(RCDATEND,6,7)
- +64 ;accounting period month
- SET $PIECE(SV2,"^",5)=MONTH
- +65 ;accounting period year
- SET $PIECE(SV2,"^",6)=FY
- +66 SET $PIECE(SV2,"^",7)="E"
- +67 ;reversal period year
- SET $PIECE(SV2,"^",12)=REVFY
- +68 ;reversal period month
- SET $PIECE(SV2,"^",13)=REVMONTH
- +69 ; document total must be positive
- if DOCTOTAL<0
- SET DOCTOTAL=-DOCTOTAL
- +70 SET $PIECE(SV2,"^",16)=$JUSTIFY(DOCTOTAL,0,2)_"^~"
- +71 ;
- +72 ; put together document in gcs
- +73 NEW %DT,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
- +74 SET Y=$EXTRACT(RCDATEND,1,5)_"00"
- DO DD^%DT
- +75 SET DESCRIP="Monthly Standard Voucher for "_Y
- +76 IF 'RCGECSDA
- DO CONTROL^GECSUFMS("A",$EXTRACT(RCTRANID,1,3),RCTRANID,"SV",10,0,"",DESCRIP)
- +77 IF RCGECSDA
- DO REBUILD^GECSUFM1(RCGECSDA,"A",10,"","Rebuild "_DESCRIP)
- SET GECSFMS("DA")=RCGECSDA
- +78 ;
- +79 ; store document in gcs
- +80 DO SETCS^GECSSTAA(GECSFMS("DA"),SV2)
- +81 FOR COUNT=1:1
- if '$DATA(FMSLINE(COUNT))
- QUIT
- DO SETCS^GECSSTAA(GECSFMS("DA"),FMSLINE(COUNT))
- +82 DO SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
- +83 DO SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
- +84 ; set the key for lookup
- +85 DO SETKEY^GECSSTAA(GECSFMS("DA"),"SV-"_$EXTRACT(RCDATEND,1,5)_RCKS)
- +86 ;
- +87 ; return 1 for success ^ fms document transaction number
- +88 QUIT "1^SV-"_$PIECE(GECSFMS("CTL"),"^",9)
- +89 ;
- +90 ;
- BADDEBT(RCRJDATE) ; top entry point to generate a sv code sheet
- +1 ; for the bad debt report, transaction types 23, 27, 2B and 2J.
- +2 ; The fms document number in file 347 is SV-$e(dateend,1,5)_"01"
- +3 ;
- +4 ; Input: RCRJDATE -- last day of accounting month
- +5 ;
- +6 NEW DATA1319,DATA1338,DATA1339,DATA4032,DATAHSIF,GECSDATA,RESULT,RCRJFMM,RCRJFXSV,RCTRANID,X,RCNOHSIF,LTCFUND,DATA133M,DATA133T
- +7 NEW DATA133N,DATA133Q,DATA133R,DATA133S
- +8 ;
- +9 ; disabled HSIF
- SET RCNOHSIF=$$NOHSIF^RCRJRCO()
- +10 ;
- +11 ; lock cannot fail
- +12 LOCK +^RC(348.1)
- +13 ;
- +14 ; get the data from the bad debt allowance file 348.1
- +15 KILL ^TMP($JOB,"RCRJRCOLSV")
- +16 SET DATA1319=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319,0)),0))
- +17 SET DATA1338=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1338,0)),0))
- +18 SET DATA1339=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1339,0)),0))
- +19 SET DATA133N=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B","133N",0)),0))
- +20 IF 'RCNOHSIF
- SET DATAHSIF=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319.1,0)),0))
- +21 SET DATA4032=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319.2,0)),0))
- +22 SET DATA133M=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319.3,0)),0))
- +23 SET DATA133T=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319.4,0)),0))
- +24 SET DATA133Q=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319.5,0)),0))
- +25 SET DATA133R=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B","133N.2",0)),0))
- +26 SET DATA133S=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1338.2,0)),0))
- +27 ;
- +28 ;PRCA*4.5*357 - add missing SGLS to report
- +29 ;1339.N3
- SET DATA13N3=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B","133N.3",0)),0))
- +30 ;1319.6
- SET DATA1396=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319.6,0)),0))
- +31 ;1319.7
- SET DATA1397=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319.7,0)),0))
- +32 ;1319.8
- SET DATA1398=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319.8,0)),0))
- +33 ;1319.9
- SET DATA1399=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319.9,0)),0))
- +34 ;1338.3
- SET DATA1383=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1338.3,0)),0))
- +35 ;1339.1
- SET DATA1391=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1339.1,0)),0))
- +36 ;end PRCA*4.5*357
- +37 ;
- +38 ;
- +39 ; the revenue source code here is a 0
- +40 ;23
- +41 SET ^TMP($JOB,"RCRJRCOLSV","23",$$ADJFUND^RCRJRCO($SELECT(DT<$$ADDPTEDT^PRCAACC():5287.3,1:528703)),0)=$PIECE(DATA1319,"^",8)
- +42 IF 'RCNOHSIF
- SET ^TMP($JOB,"RCRJRCOLSV","23",5358.1,0)=$PIECE(DATAHSIF,"^",8)
- +43 ;patch 220 replaces 4032 fund with 528709
- +44 SET LTCFUND=$SELECT(DT'<$$ADDPTEDT^PRCAACC():528709,1:4032)
- +45 SET ^TMP($JOB,"RCRJRCOLSV","23",LTCFUND,0)=$PIECE(DATA4032,"^",8)
- +46 SET ^TMP($JOB,"RCRJRCOLSV","23",528701,0)=$PIECE(DATA133M,"^",8)
- +47 SET ^TMP($JOB,"RCRJRCOLSV","23",528704,0)=$PIECE(DATA133T,"^",8)
- +48 SET ^TMP($JOB,"RCRJRCOLSV","23",528711,0)=$PIECE(DATA133Q,"^",8)
- +49 SET ^TMP($JOB,"RCRJRCOLSV","23",528713,0)=$PIECE(DATA1396,"^",8)
- +50 SET ^TMP($JOB,"RCRJRCOLSV","23",528714,0)=$PIECE(DATA1397,"^",8)+$PIECE(DATA1398,"^",8)+$PIECE(DATA1399,"^",8)
- +51 ;27
- +52 SET ^TMP($JOB,"RCRJRCOLSV","27",528713,0)=$PIECE(DATA1391,"^",8)
- +53 ;2J
- +54 SET ^TMP($JOB,"RCRJRCOLSV","2J",528711,0)=$PIECE(DATA133R,"^",8)
- +55 SET ^TMP($JOB,"RCRJRCOLSV","2J",528713,0)=$PIECE(DATA13N3,"^",8)
- +56 ;2B
- +57 SET ^TMP($JOB,"RCRJRCOLSV","2B",528711,0)=$PIECE(DATA133S,"^",8)
- +58 SET ^TMP($JOB,"RCRJRCOLSV","2B",528713,0)=$PIECE(DATA1383,"^",8)
- +59 ;
- +60 ;Pre MRA funds
- +61 SET ^TMP($JOB,"RCRJRCOLSV","2B",$$ADJFUND^RCRJRCO($SELECT(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$PIECE(DATA1338,"^",8)
- +62 SET ^TMP($JOB,"RCRJRCOLSV","27",$$ADJFUND^RCRJRCO($SELECT(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$PIECE(DATA1339,"^",8)
- +63 ; post-MRA non-Medicare bills
- +64 SET ^TMP($JOB,"RCRJRCOLSV","2J",$$ADJFUND^RCRJRCO($SELECT(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$PIECE(DATA133N,"^",8)
- +65 ;
- +66 ; the date is for previous month
- +67 ;S RCRJDATE=$$PREVMONT^RCRJRBD(DT)
- +68 ;I $E(DT,6,7)<$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$$PREVMONT^RCRJRBD(DT)
- +69 ;I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$E($$LDATE^RCRJR(DT),1,5)_"00"
- +70 ;I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$$LDATE^RCRJR(DT)
- +71 ; find the last day of the month for the end date
- +72 ;S RCRJDATE=$E(RCRJDATE,1,5)_$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(RCRJDATE,4,5))
- +73 ;I $E(RCRJDATE,6,7)=28,$E(RCRJDATE,2,3)#4=0 S RCRJDATE=$E(RCRJDATE,1,5)_"29"
- +74 ;
- +75 ; lookup fms document number to see if the monthly sv has been sent
- +76 ; example rcdatend=3010531, lookup on 3010501
- +77 DO KEYLOOK^GECSSGET("SV-"_$EXTRACT(RCRJDATE,1,5)_"01",1)
- +78 ;
- +79 ; get the transacion id for the fms document
- +80 ; if it is not sent, get the next number available
- +81 IF $GET(GECSDATA)
- SET RCTRANID=$EXTRACT($PIECE(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
- +82 IF $GET(RCTRANID)=""
- SET RCTRANID=$$ENUM^RCMSNUM
- +83 ;unable to retrieve the next number
- IF RCTRANID<0
- QUIT
- +84 ; remove dash (example 460-K1A05HY)
- +85 SET RCTRANID=$TRANSLATE(RCTRANID,"-")
- +86 ;
- +87 ; build and send the sv document to fms
- +88 SET RESULT=$$BUILDSV(RCRJDATE,+$GET(GECSDATA),RCTRANID,"01")
- +89 KILL ^TMP($JOB,"RCRJRCOLSV")
- +90 ; error in building code sheet
- +91 IF 'RESULT
- DO Q
- QUIT
- +92 ;
- +93 ; add/update entry in file 347 for reports
- +94 NEW %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
- +95 SET DA347=$ORDER(^RC(347,"D","SV-"_$EXTRACT(RCRJDATE,1,5)_"01",0))
- +96 ; if not in the file, addit fmsdocid sv id
- +97 IF 'DA347
- DO OPEN^RCFMDRV1($PIECE(RESULT,"^",2),4,"SV-"_$EXTRACT(RCRJDATE,1,5)_"01",.DA347,.ERROR)
- +98 IF DA347
- DO SSTAT^RCFMFN02($PIECE(RESULT,"^",2),1)
- +99 ;
- Q ; jump here to finish
- +1 ; generate bad debt report
- +2 SET RCRJFXSV=$PIECE(RESULT,"^",2)
- SET RCRJFMM=1
- DO DQ^RCRJRBDR
- +3 LOCK -^RC(348.1)
- +4 QUIT