- RCXFMSTX ;WISC/RFJ-fms transfer (tr) code sheet generator ;1 Oct 97
- ;;4.5;Accounts Receivable;**170,178,191,184**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- STARTTR(RCDATEND) ; top entry point to generate a tr code sheet
- ; transferring dollars from mccf to hsif
- ;
- ; 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
- ;
- ;
- N GECSDATA,RCTRANID,RESULT
- ;
- ; build the data for the TR document. this call returns the rctrans
- ; array in the format rctrans(fromfund,fromrsc) = tofund ^ torsc ^
- ; amount
- ; example:
- ; rctrans(5287,"8bzz")="5358.1^8gzz^123.45"
- ; will transfer 123.45 from 5287 to 5358.1
- D GETPAY^RCBMILLT(RCDATEND)
- ;
- ; no code sheets to send
- I $O(RCTRANS(""))="" Q
- ;
- ; lookup fms document number to see if the monthly tr has been sent
- ; example rcdatend=3010531, lookup on 3010500
- D KEYLOOK^GECSSGET("TR-"_$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 the tr document
- S RESULT=$$BUILDTR(RCDATEND,.RCTRANS,+$G(GECSDATA),RCTRANID)
- ; error in building code sheet
- I 'RESULT Q
- ;
- ; set the 433 fields showing the dollars were transferred
- D SETPAY^RCBMILLT(RCDATEND)
- ;
- ; 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,"TR-"_$E(RCDATEND,1,5)_"00",.DA347,.ERROR)
- I DA347 D SSTAT^RCFMFN02($P(RESULT,"^",2),1)
- Q
- ;
- ;
- BUILDTR(RCDATEND,RCTRANS,RCGECSDA,RCTRANID) ; generate a tr code sheet for
- ; transferring dollars from mccf to hsif
- ;
- ; rcdatend is the last day of the month for the data
- ;
- ; rctrans(fund,rsc) = data array passed
- ; fund=fund to transfer from
- ; rsc = rsc to transfer from
- ; data = fund to transfer to (piece 1)
- ; rsc to transfer to (piece 2)
- ; dollars to transfer (piece 3)
- ;
- ; rcgecsda is the ien for the gcs stack file 2100.1 for rebuilds
- ;
- ; rctranid is the document identifier
- ;
- N COUNT,DATA,DESCRIP,FISCALYR,FUND,GECSFMS,LINE,REVSRCE,TR2,X,Y
- ;
- S FISCALYR=$$FY^RCFN01(RCDATEND)
- ;
- ; build detail line
- S COUNT=0
- S FUND="" F S FUND=$O(RCTRANS(FUND)) Q:FUND="" D
- . S REVSRCE="" F S REVSRCE=$O(RCTRANS(FUND,REVSRCE)) Q:'REVSRCE D
- . . S DATA=RCTRANS(FUND,REVSRCE)
- . . ; if no value, quit
- . . I '$P(DATA,"^",3) Q
- . . ;
- . . ; create line to transfer from (decrease)
- . . S COUNT=COUNT+1
- . . S LINE(COUNT)="LIN^~CRA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
- . . S $P(LINE(COUNT),"^",4)=FISCALYR
- . . S $P(LINE(COUNT),U,4)=$S($E(FUND,1,4)=5287:"05",1:FISCALYR)
- . . S $P(LINE(COUNT),"^",6)=FUND
- . . S $P(LINE(COUNT),"^",7)=$E(RCTRANID,1,3) ; station #
- . . S $P(LINE(COUNT),"^",10)=REVSRCE
- . . ;
- . . ; vendor id
- . . S $P(LINE(COUNT),"^",18)="MCCFVALUE"
- . . I FUND=5358.1 S $P(LINE(COUNT),"^",18)="HSIFVALUE"
- . . ;
- . . S $P(LINE(COUNT),"^",20)=$J($P(DATA,"^",3),0,2)
- . . S $P(LINE(COUNT),"^",21)="D"
- . . S $P(LINE(COUNT),"^",23)=33
- . . S $P(LINE(COUNT),"^",24)="~"
- . . ;
- . . ; create line to transfer to (increase)
- . . S COUNT=COUNT+1
- . . S LINE(COUNT)="LIN^~CRA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
- . . S $P(LINE(COUNT),"^",4)=FISCALYR
- . . S $P(LINE(COUNT),U,4)=$S($E(FUND,1,4)=5287:"05",1:FISCALYR)
- . . S $P(LINE(COUNT),"^",6)=$P(DATA,"^")
- . . S $P(LINE(COUNT),"^",7)=$E(RCTRANID,1,3) ; station #
- . . S $P(LINE(COUNT),"^",10)=$P(DATA,"^",2)
- . . ;
- . . ; vendor id
- . . S $P(LINE(COUNT),"^",18)="MCCFVALUE"
- . . I $P(DATA,"^")=5358.1 S $P(LINE(COUNT),"^",18)="HSIFVALUE"
- . . ;
- . . S $P(LINE(COUNT),"^",20)=$J($P(DATA,"^",3),0,2)
- . . S $P(LINE(COUNT),"^",21)="I"
- . . S $P(LINE(COUNT),"^",23)=33
- . . S $P(LINE(COUNT),"^",24)="~"
- ;
- ; build tr2
- S TR2="CR2^"_$E(RCDATEND,2,3)_"^"_$E(RCDATEND,4,5)_"^"_$E(RCDATEND,6,7)_"^^^^^^E^^^"
- ; deposit number which is equal to the gcs id
- ; $j(0,0,2) is the document total which is zero
- S TR2=TR2_$P(RCTRANID,"^")_"^^"_$J(0,0,2)_"^^"
- ; deposit/transfer date which is end date of prior month
- S TR2=TR2_$E(RCDATEND,2,3)_"^"_$E(RCDATEND,4,5)_"^"_$E(RCDATEND,6,7)_"^~"
- ;
- ; put together document in gcs
- N %DT,D,D0,DA,DI,DIC,DIE,DIQ2,DQ,DR
- S Y=$E(RCDATEND,1,5)_"00" D DD^%DT
- S DESCRIP="Monthly Transfer MCCF to HSIF for "_Y
- I 'RCGECSDA D CONTROL^GECSUFMS("A",$E(RCTRANID,1,3),RCTRANID,"TR",10,0,"",DESCRIP)
- I RCGECSDA D REBUILD^GECSUFM1(RCGECSDA,"A",10,"N","Rebuild "_DESCRIP) S GECSFMS("DA")=RCGECSDA
- ;
- ; store document in gcs
- D SETCS^GECSSTAA(GECSFMS("DA"),TR2)
- F COUNT=1:1 Q:'$D(LINE(COUNT)) D SETCS^GECSSTAA(GECSFMS("DA"),LINE(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"),"TR-"_$E(RCDATEND,1,5)_"00")
- ;
- ; return 1 for success ^ fms document id
- Q 1_"^TR-"_$P(GECSFMS("CTL"),"^",9)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXFMSTX 5877 printed Feb 18, 2025@23:15:44 Page 2
- RCXFMSTX ;WISC/RFJ-fms transfer (tr) code sheet generator ;1 Oct 97
- +1 ;;4.5;Accounts Receivable;**170,178,191,184**;Mar 20, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- STARTTR(RCDATEND) ; top entry point to generate a tr code sheet
- +1 ; transferring dollars from mccf to hsif
- +2 ;
- +3 ; rcdatend is the ending date of the period.
- +4 ; This date is the 3rd work day from the end of the month.
- +5 ; The utility $$LDATE^RCRJR is used to figure it out. It will
- +6 ; change from month to month and figures in holidays also.
- +7 ; For example, if running the ARDC for the month of June 2003
- +8 ; the EOAM will calculate out to be June 25, 2003.
- +9 ; This is called by the background monthly data collector
- +10 ;
- +11 ;
- +12 NEW GECSDATA,RCTRANID,RESULT
- +13 ;
- +14 ; build the data for the TR document. this call returns the rctrans
- +15 ; array in the format rctrans(fromfund,fromrsc) = tofund ^ torsc ^
- +16 ; amount
- +17 ; example:
- +18 ; rctrans(5287,"8bzz")="5358.1^8gzz^123.45"
- +19 ; will transfer 123.45 from 5287 to 5358.1
- +20 DO GETPAY^RCBMILLT(RCDATEND)
- +21 ;
- +22 ; no code sheets to send
- +23 IF $ORDER(RCTRANS(""))=""
- QUIT
- +24 ;
- +25 ; lookup fms document number to see if the monthly tr has been sent
- +26 ; example rcdatend=3010531, lookup on 3010500
- +27 DO KEYLOOK^GECSSGET("TR-"_$EXTRACT(RCDATEND,1,5)_"00",1)
- +28 ;
- +29 ; get the transacion id for the fms document
- +30 ; if it is not sent, get the next number available
- +31 IF $GET(GECSDATA)
- SET RCTRANID=$EXTRACT($PIECE(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
- +32 IF $GET(RCTRANID)=""
- SET RCTRANID=$$ENUM^RCMSNUM
- +33 ;unable to retrieve the next number
- IF RCTRANID<0
- QUIT
- +34 ; remove dash (example 460-K1A05HY)
- +35 SET RCTRANID=$TRANSLATE(RCTRANID,"-")
- +36 ;
- +37 ; build the tr document
- +38 SET RESULT=$$BUILDTR(RCDATEND,.RCTRANS,+$GET(GECSDATA),RCTRANID)
- +39 ; error in building code sheet
- +40 IF 'RESULT
- QUIT
- +41 ;
- +42 ; set the 433 fields showing the dollars were transferred
- +43 DO SETPAY^RCBMILLT(RCDATEND)
- +44 ;
- +45 ; add/update entry in file 347 for reports
- +46 NEW %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
- +47 SET DA347=$ORDER(^RC(347,"C",$PIECE(RESULT,"^",2),0))
- +48 ; if not in the file, addit fmsdocid sv id
- +49 IF 'DA347
- DO OPEN^RCFMDRV1($PIECE(RESULT,"^",2),4,"TR-"_$EXTRACT(RCDATEND,1,5)_"00",.DA347,.ERROR)
- +50 IF DA347
- DO SSTAT^RCFMFN02($PIECE(RESULT,"^",2),1)
- +51 QUIT
- +52 ;
- +53 ;
- BUILDTR(RCDATEND,RCTRANS,RCGECSDA,RCTRANID) ; generate a tr code sheet for
- +1 ; transferring dollars from mccf to hsif
- +2 ;
- +3 ; rcdatend is the last day of the month for the data
- +4 ;
- +5 ; rctrans(fund,rsc) = data array passed
- +6 ; fund=fund to transfer from
- +7 ; rsc = rsc to transfer from
- +8 ; data = fund to transfer to (piece 1)
- +9 ; rsc to transfer to (piece 2)
- +10 ; dollars to transfer (piece 3)
- +11 ;
- +12 ; rcgecsda is the ien for the gcs stack file 2100.1 for rebuilds
- +13 ;
- +14 ; rctranid is the document identifier
- +15 ;
- +16 NEW COUNT,DATA,DESCRIP,FISCALYR,FUND,GECSFMS,LINE,REVSRCE,TR2,X,Y
- +17 ;
- +18 SET FISCALYR=$$FY^RCFN01(RCDATEND)
- +19 ;
- +20 ; build detail line
- +21 SET COUNT=0
- +22 SET FUND=""
- FOR
- SET FUND=$ORDER(RCTRANS(FUND))
- if FUND=""
- QUIT
- Begin DoDot:1
- +23 SET REVSRCE=""
- FOR
- SET REVSRCE=$ORDER(RCTRANS(FUND,REVSRCE))
- if 'REVSRCE
- QUIT
- Begin DoDot:2
- +24 SET DATA=RCTRANS(FUND,REVSRCE)
- +25 ; if no value, quit
- +26 IF '$PIECE(DATA,"^",3)
- QUIT
- +27 ;
- +28 ; create line to transfer from (decrease)
- +29 SET COUNT=COUNT+1
- +30 SET LINE(COUNT)="LIN^~CRA^"_$SELECT($LENGTH(COUNT)=1:"00",$LENGTH(COUNT)=2:"0",1:"")_COUNT
- +31 SET $PIECE(LINE(COUNT),"^",4)=FISCALYR
- +32 SET $PIECE(LINE(COUNT),U,4)=$SELECT($EXTRACT(FUND,1,4)=5287:"05",1:FISCALYR)
- +33 SET $PIECE(LINE(COUNT),"^",6)=FUND
- +34 ; station #
- SET $PIECE(LINE(COUNT),"^",7)=$EXTRACT(RCTRANID,1,3)
- +35 SET $PIECE(LINE(COUNT),"^",10)=REVSRCE
- +36 ;
- +37 ; vendor id
- +38 SET $PIECE(LINE(COUNT),"^",18)="MCCFVALUE"
- +39 IF FUND=5358.1
- SET $PIECE(LINE(COUNT),"^",18)="HSIFVALUE"
- +40 ;
- +41 SET $PIECE(LINE(COUNT),"^",20)=$JUSTIFY($PIECE(DATA,"^",3),0,2)
- +42 SET $PIECE(LINE(COUNT),"^",21)="D"
- +43 SET $PIECE(LINE(COUNT),"^",23)=33
- +44 SET $PIECE(LINE(COUNT),"^",24)="~"
- +45 ;
- +46 ; create line to transfer to (increase)
- +47 SET COUNT=COUNT+1
- +48 SET LINE(COUNT)="LIN^~CRA^"_$SELECT($LENGTH(COUNT)=1:"00",$LENGTH(COUNT)=2:"0",1:"")_COUNT
- +49 SET $PIECE(LINE(COUNT),"^",4)=FISCALYR
- +50 SET $PIECE(LINE(COUNT),U,4)=$SELECT($EXTRACT(FUND,1,4)=5287:"05",1:FISCALYR)
- +51 SET $PIECE(LINE(COUNT),"^",6)=$PIECE(DATA,"^")
- +52 ; station #
- SET $PIECE(LINE(COUNT),"^",7)=$EXTRACT(RCTRANID,1,3)
- +53 SET $PIECE(LINE(COUNT),"^",10)=$PIECE(DATA,"^",2)
- +54 ;
- +55 ; vendor id
- +56 SET $PIECE(LINE(COUNT),"^",18)="MCCFVALUE"
- +57 IF $PIECE(DATA,"^")=5358.1
- SET $PIECE(LINE(COUNT),"^",18)="HSIFVALUE"
- +58 ;
- +59 SET $PIECE(LINE(COUNT),"^",20)=$JUSTIFY($PIECE(DATA,"^",3),0,2)
- +60 SET $PIECE(LINE(COUNT),"^",21)="I"
- +61 SET $PIECE(LINE(COUNT),"^",23)=33
- +62 SET $PIECE(LINE(COUNT),"^",24)="~"
- End DoDot:2
- End DoDot:1
- +63 ;
- +64 ; build tr2
- +65 SET TR2="CR2^"_$EXTRACT(RCDATEND,2,3)_"^"_$EXTRACT(RCDATEND,4,5)_"^"_$EXTRACT(RCDATEND,6,7)_"^^^^^^E^^^"
- +66 ; deposit number which is equal to the gcs id
- +67 ; $j(0,0,2) is the document total which is zero
- +68 SET TR2=TR2_$PIECE(RCTRANID,"^")_"^^"_$JUSTIFY(0,0,2)_"^^"
- +69 ; deposit/transfer date which is end date of prior month
- +70 SET TR2=TR2_$EXTRACT(RCDATEND,2,3)_"^"_$EXTRACT(RCDATEND,4,5)_"^"_$EXTRACT(RCDATEND,6,7)_"^~"
- +71 ;
- +72 ; put together document in gcs
- +73 NEW %DT,D,D0,DA,DI,DIC,DIE,DIQ2,DQ,DR
- +74 SET Y=$EXTRACT(RCDATEND,1,5)_"00"
- DO DD^%DT
- +75 SET DESCRIP="Monthly Transfer MCCF to HSIF for "_Y
- +76 IF 'RCGECSDA
- DO CONTROL^GECSUFMS("A",$EXTRACT(RCTRANID,1,3),RCTRANID,"TR",10,0,"",DESCRIP)
- +77 IF RCGECSDA
- DO REBUILD^GECSUFM1(RCGECSDA,"A",10,"N","Rebuild "_DESCRIP)
- SET GECSFMS("DA")=RCGECSDA
- +78 ;
- +79 ; store document in gcs
- +80 DO SETCS^GECSSTAA(GECSFMS("DA"),TR2)
- +81 FOR COUNT=1:1
- if '$DATA(LINE(COUNT))
- QUIT
- DO SETCS^GECSSTAA(GECSFMS("DA"),LINE(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"),"TR-"_$EXTRACT(RCDATEND,1,5)_"00")
- +86 ;
- +87 ; return 1 for success ^ fms document id
- +88 QUIT 1_"^TR-"_$PIECE(GECSFMS("CTL"),"^",9)