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 Dec 13, 2024@01:49:20 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)
