| 1 | RCXFMSWR ;WISC/RFJ-fms writeoff (wr) code sheet generator ;1 Nov 97
|
|---|
| 2 | ;;4.5;Accounts Receivable;**96,135,98,156,170,191,220,184**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | STARTWR(RCDATEND) ; top entry point to generate a wr code sheet
|
|---|
| 8 | ;
|
|---|
| 9 | ; rcdatend is the ending date of the period.
|
|---|
| 10 | ; This date is the 3rd work day from the end of the month.
|
|---|
| 11 | ; The utility $$LDATE^RCRJR is used to figure it out. It will
|
|---|
| 12 | ; change from month to month and figures in holidays also.
|
|---|
| 13 | ; For example, if running the ARDC for the month of June 2003
|
|---|
| 14 | ; the EOAM will calculate out to be June 25, 2003.
|
|---|
| 15 | ; This is called by the background monthly data collector
|
|---|
| 16 | ;
|
|---|
| 17 | ; data stored in tmp($j,rcrjrcolwr,type,revsourcecode)
|
|---|
| 18 | ; this is called by the background monthly data collector
|
|---|
| 19 | ;
|
|---|
| 20 | N GECSDATA,RCTRANID,RESULT
|
|---|
| 21 | ; lookup fms document number to see if the monthly sv has been sent
|
|---|
| 22 | ; example rcdatend=3010531, lookup on 3010500
|
|---|
| 23 | D KEYLOOK^GECSSGET("WR-"_$E(RCDATEND,1,5)_"00",1)
|
|---|
| 24 | ;
|
|---|
| 25 | ; get the transacion id for the fms document
|
|---|
| 26 | ; if it is not sent, get the next number available
|
|---|
| 27 | I $G(GECSDATA) S RCTRANID=$E($P(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
|
|---|
| 28 | I $G(RCTRANID)="" S RCTRANID=$$ENUM^RCMSNUM
|
|---|
| 29 | I RCTRANID<0 Q ;unable to retrieve the next number
|
|---|
| 30 | ; remove dash (example 460-K1A05HY)
|
|---|
| 31 | S RCTRANID=$TR(RCTRANID,"-")
|
|---|
| 32 | ;
|
|---|
| 33 | ; build and send the sv document to fms
|
|---|
| 34 | S RESULT=$$BUILDWR(RCDATEND,+$G(GECSDATA),RCTRANID)
|
|---|
| 35 | ; error in building code sheet
|
|---|
| 36 | I 'RESULT Q
|
|---|
| 37 | ;
|
|---|
| 38 | ; add/update entry in file 347 for reports
|
|---|
| 39 | N %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
|
|---|
| 40 | S DA347=$O(^RC(347,"D","WR-"_$E(RCDATEND,1,5)_"00",0))
|
|---|
| 41 | ; if not in the file, addit fmsdocid wr id
|
|---|
| 42 | I 'DA347 D OPEN^RCFMDRV1($P(RESULT,"^",2),8,"WR-"_$E(RCDATEND,1,5)_"00",.DA347,.ERROR)
|
|---|
| 43 | I DA347 D SSTAT^RCFMFN02($P(RESULT,"^",2),1)
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | ;
|
|---|
| 47 | BUILDWR(RCDATEND,RCGECSDA,RCTRANID) ; generate a wr code sheet for monthly data
|
|---|
| 48 | ; rcgecsda is the ien for the gcs stack file 2100.1 for rebuilds
|
|---|
| 49 | ; data stored in tmp($j,rcrjrcolwr)
|
|---|
| 50 | ;
|
|---|
| 51 | N AMOUNT,COUNT,CR2,DESCRIP,DOCTOTAL,FISCALYR,FMSLINE,FUND,GECSFMS,RSC,TYPE
|
|---|
| 52 | ;
|
|---|
| 53 | S FISCALYR=$$FY^RCFN01(RCDATEND)
|
|---|
| 54 | ;
|
|---|
| 55 | S COUNT=0,DOCTOTAL=0
|
|---|
| 56 | S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLWR",TYPE)) Q:TYPE="" D
|
|---|
| 57 | . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND)) Q:FUND="" D
|
|---|
| 58 | . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND,RSC)) Q:RSC="" D
|
|---|
| 59 | . . . S AMOUNT=^TMP($J,"RCRJRCOLWR",TYPE,FUND,RSC),DOCTOTAL=DOCTOTAL+AMOUNT
|
|---|
| 60 | . . . I AMOUNT=0 Q
|
|---|
| 61 | . . . S COUNT=COUNT+1
|
|---|
| 62 | . . . S FMSLINE(COUNT)="LIN^~CRA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
|
|---|
| 63 | . . . ;S $P(FMSLINE(COUNT),"^",4)=$S(FUND=4032:"03",1:FISCALYR) ;begin fy
|
|---|
| 64 | . . . S $P(FMSLINE(COUNT),"^",4)=FISCALYR ;begin fy
|
|---|
| 65 | . . . S $P(FMSLINE(COUNT),"^",4)=$S($E(FUND,1,4)=5287:"05",1:FISCALYR) ;begin fy
|
|---|
| 66 | . . . S $P(FMSLINE(COUNT),"^",6)=FUND
|
|---|
| 67 | . . . S $P(FMSLINE(COUNT),"^",7)=$E(RCTRANID,1,3) ;site number
|
|---|
| 68 | . . . S $P(FMSLINE(COUNT),"^",10)=RSC
|
|---|
| 69 | . . . ;
|
|---|
| 70 | . . . ; vendor id
|
|---|
| 71 | . . . S $P(FMSLINE(COUNT),"^",18)="MCCFVALUE"
|
|---|
| 72 | . . . I FUND=4032!(FUND=528709) S $P(FMSLINE(COUNT),"^",18)="EXCFVALUE"
|
|---|
| 73 | . . . ; for transaction type P4, send vendorid of PERSONOTH
|
|---|
| 74 | . . . I TYPE="P4" S $P(FMSLINE(COUNT),"^",18)="PERSONOTH"
|
|---|
| 75 | . . . ;
|
|---|
| 76 | . . . S $P(FMSLINE(COUNT),"^",20)=$J(AMOUNT,0,2)
|
|---|
| 77 | . . . S $P(FMSLINE(COUNT),"^",21)="I"
|
|---|
| 78 | . . . S $P(FMSLINE(COUNT),"^",23)=TYPE_"^~"
|
|---|
| 79 | ;
|
|---|
| 80 | ; no code sheets to send
|
|---|
| 81 | I COUNT=0 Q "0^No wr code sheets to send for this month"
|
|---|
| 82 | ;
|
|---|
| 83 | S CR2="CR2^"_$E(RCDATEND,2,3)_"^"_$E(RCDATEND,4,5)_"^"_$E(RCDATEND,6,7)
|
|---|
| 84 | S $P(CR2,"^",10)="E"
|
|---|
| 85 | S $P(CR2,"^",13)=999999999999
|
|---|
| 86 | S $P(CR2,"^",15)=$J(DOCTOTAL,0,2)
|
|---|
| 87 | S $P(CR2,"^",17)=$E(RCDATEND,2,3)
|
|---|
| 88 | S $P(CR2,"^",18)=$E(RCDATEND,4,5)
|
|---|
| 89 | S $P(CR2,"^",19)=$E(RCDATEND,6,7)_"^~"
|
|---|
| 90 | ;
|
|---|
| 91 | ; put together document in gcs
|
|---|
| 92 | N %DT,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
|
|---|
| 93 | S Y=$E(RCDATEND,1,5)_"00" D DD^%DT
|
|---|
| 94 | S DESCRIP="Monthly Write Off for "_Y
|
|---|
| 95 | I 'RCGECSDA D CONTROL^GECSUFMS("A",$E(RCTRANID,1,3),RCTRANID,"WR",10,0,"",DESCRIP)
|
|---|
| 96 | I RCGECSDA D REBUILD^GECSUFM1(RCGECSDA,"A",10,"N","Rebuild "_DESCRIP) S GECSFMS("DA")=RCGECSDA
|
|---|
| 97 | ;
|
|---|
| 98 | ; store document in gcs
|
|---|
| 99 | D SETCS^GECSSTAA(GECSFMS("DA"),CR2)
|
|---|
| 100 | F COUNT=1:1 Q:'$D(FMSLINE(COUNT)) D SETCS^GECSSTAA(GECSFMS("DA"),FMSLINE(COUNT))
|
|---|
| 101 | D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
|
|---|
| 102 | D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
|
|---|
| 103 | ; set the key for lookup
|
|---|
| 104 | D SETKEY^GECSSTAA(GECSFMS("DA"),"WR-"_$E(RCDATEND,1,5)_"00")
|
|---|
| 105 | ;
|
|---|
| 106 | ; return 1 for success ^ fms document transaction number
|
|---|
| 107 | Q "1^WR-"_$P(GECSFMS("CTL"),"^",9)
|
|---|
