- RCXFMSWR ;WISC/RFJ-fms writeoff (wr) code sheet generator ;1 Nov 97
- ;;4.5;Accounts Receivable;**96,135,98,156,170,191,220,184**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- STARTWR(RCDATEND) ; top entry point to generate a wr 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,rcrjrcolwr,type,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("WR-"_$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=$$BUILDWR(RCDATEND,+$G(GECSDATA),RCTRANID)
- ; 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,"D","WR-"_$E(RCDATEND,1,5)_"00",0))
- ; if not in the file, addit fmsdocid wr id
- I 'DA347 D OPEN^RCFMDRV1($P(RESULT,"^",2),8,"WR-"_$E(RCDATEND,1,5)_"00",.DA347,.ERROR)
- I DA347 D SSTAT^RCFMFN02($P(RESULT,"^",2),1)
- Q
- ;
- ;
- BUILDWR(RCDATEND,RCGECSDA,RCTRANID) ; 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,rcrjrcolwr)
- ;
- N AMOUNT,COUNT,CR2,DESCRIP,DOCTOTAL,FISCALYR,FMSLINE,FUND,GECSFMS,RSC,TYPE
- ;
- S FISCALYR=$$FY^RCFN01(RCDATEND)
- ;
- S COUNT=0,DOCTOTAL=0
- S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLWR",TYPE)) Q:TYPE="" D
- . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND)) Q:FUND="" D
- . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND,RSC)) Q:RSC="" D
- . . . S AMOUNT=^TMP($J,"RCRJRCOLWR",TYPE,FUND,RSC),DOCTOTAL=DOCTOTAL+AMOUNT
- . . . I AMOUNT=0 Q
- . . . S COUNT=COUNT+1
- . . . S FMSLINE(COUNT)="LIN^~CRA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
- . . . ;S $P(FMSLINE(COUNT),"^",4)=$S(FUND=4032:"03",1:FISCALYR) ;begin fy
- . . . S $P(FMSLINE(COUNT),"^",4)=FISCALYR ;begin fy
- . . . S $P(FMSLINE(COUNT),"^",4)=$S($E(FUND,1,4)=5287:"05",1:FISCALYR) ;begin fy
- . . . S $P(FMSLINE(COUNT),"^",6)=FUND
- . . . S $P(FMSLINE(COUNT),"^",7)=$E(RCTRANID,1,3) ;site number
- . . . S $P(FMSLINE(COUNT),"^",10)=RSC
- . . . ;
- . . . ; vendor id
- . . . S $P(FMSLINE(COUNT),"^",18)="MCCFVALUE"
- . . . I FUND=4032!(FUND=528709) S $P(FMSLINE(COUNT),"^",18)="EXCFVALUE"
- . . . ; for transaction type P4, send vendorid of PERSONOTH
- . . . I TYPE="P4" S $P(FMSLINE(COUNT),"^",18)="PERSONOTH"
- . . . ;
- . . . S $P(FMSLINE(COUNT),"^",20)=$J(AMOUNT,0,2)
- . . . S $P(FMSLINE(COUNT),"^",21)="I"
- . . . S $P(FMSLINE(COUNT),"^",23)=TYPE_"^~"
- ;
- ; no code sheets to send
- I COUNT=0 Q "0^No wr code sheets to send for this month"
- ;
- S CR2="CR2^"_$E(RCDATEND,2,3)_"^"_$E(RCDATEND,4,5)_"^"_$E(RCDATEND,6,7)
- S $P(CR2,"^",10)="E"
- S $P(CR2,"^",13)=999999999999
- S $P(CR2,"^",15)=$J(DOCTOTAL,0,2)
- S $P(CR2,"^",17)=$E(RCDATEND,2,3)
- S $P(CR2,"^",18)=$E(RCDATEND,4,5)
- S $P(CR2,"^",19)=$E(RCDATEND,6,7)_"^~"
- ;
- ; 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 Write Off for "_Y
- I 'RCGECSDA D CONTROL^GECSUFMS("A",$E(RCTRANID,1,3),RCTRANID,"WR",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"),CR2)
- 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"),"WR-"_$E(RCDATEND,1,5)_"00")
- ;
- ; return 1 for success ^ fms document transaction number
- Q "1^WR-"_$P(GECSFMS("CTL"),"^",9)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXFMSWR 4726 printed Mar 13, 2025@20:54:05 Page 2
- RCXFMSWR ;WISC/RFJ-fms writeoff (wr) code sheet generator ;1 Nov 97
- +1 ;;4.5;Accounts Receivable;**96,135,98,156,170,191,220,184**;Mar 20, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- STARTWR(RCDATEND) ; top entry point to generate a wr 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,rcrjrcolwr,type,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("WR-"_$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=$$BUILDWR(RCDATEND,+$GET(GECSDATA),RCTRANID)
- +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,"D","WR-"_$EXTRACT(RCDATEND,1,5)_"00",0))
- +34 ; if not in the file, addit fmsdocid wr id
- +35 IF 'DA347
- DO OPEN^RCFMDRV1($PIECE(RESULT,"^",2),8,"WR-"_$EXTRACT(RCDATEND,1,5)_"00",.DA347,.ERROR)
- +36 IF DA347
- DO SSTAT^RCFMFN02($PIECE(RESULT,"^",2),1)
- +37 QUIT
- +38 ;
- +39 ;
- BUILDWR(RCDATEND,RCGECSDA,RCTRANID) ; 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,rcrjrcolwr)
- +3 ;
- +4 NEW AMOUNT,COUNT,CR2,DESCRIP,DOCTOTAL,FISCALYR,FMSLINE,FUND,GECSFMS,RSC,TYPE
- +5 ;
- +6 SET FISCALYR=$$FY^RCFN01(RCDATEND)
- +7 ;
- +8 SET COUNT=0
- SET DOCTOTAL=0
- +9 SET TYPE=""
- FOR
- SET TYPE=$ORDER(^TMP($JOB,"RCRJRCOLWR",TYPE))
- if TYPE=""
- QUIT
- Begin DoDot:1
- +10 SET FUND=""
- FOR
- SET FUND=$ORDER(^TMP($JOB,"RCRJRCOLWR",TYPE,FUND))
- if FUND=""
- QUIT
- Begin DoDot:2
- +11 SET RSC=""
- FOR
- SET RSC=$ORDER(^TMP($JOB,"RCRJRCOLWR",TYPE,FUND,RSC))
- if RSC=""
- QUIT
- Begin DoDot:3
- +12 SET AMOUNT=^TMP($JOB,"RCRJRCOLWR",TYPE,FUND,RSC)
- SET DOCTOTAL=DOCTOTAL+AMOUNT
- +13 IF AMOUNT=0
- QUIT
- +14 SET COUNT=COUNT+1
- +15 SET FMSLINE(COUNT)="LIN^~CRA^"_$SELECT($LENGTH(COUNT)=1:"00",$LENGTH(COUNT)=2:"0",1:"")_COUNT
- +16 ;S $P(FMSLINE(COUNT),"^",4)=$S(FUND=4032:"03",1:FISCALYR) ;begin fy
- +17 ;begin fy
- SET $PIECE(FMSLINE(COUNT),"^",4)=FISCALYR
- +18 ;begin fy
- SET $PIECE(FMSLINE(COUNT),"^",4)=$SELECT($EXTRACT(FUND,1,4)=5287:"05",1:FISCALYR)
- +19 SET $PIECE(FMSLINE(COUNT),"^",6)=FUND
- +20 ;site number
- SET $PIECE(FMSLINE(COUNT),"^",7)=$EXTRACT(RCTRANID,1,3)
- +21 SET $PIECE(FMSLINE(COUNT),"^",10)=RSC
- +22 ;
- +23 ; vendor id
- +24 SET $PIECE(FMSLINE(COUNT),"^",18)="MCCFVALUE"
- +25 IF FUND=4032!(FUND=528709)
- SET $PIECE(FMSLINE(COUNT),"^",18)="EXCFVALUE"
- +26 ; for transaction type P4, send vendorid of PERSONOTH
- +27 IF TYPE="P4"
- SET $PIECE(FMSLINE(COUNT),"^",18)="PERSONOTH"
- +28 ;
- +29 SET $PIECE(FMSLINE(COUNT),"^",20)=$JUSTIFY(AMOUNT,0,2)
- +30 SET $PIECE(FMSLINE(COUNT),"^",21)="I"
- +31 SET $PIECE(FMSLINE(COUNT),"^",23)=TYPE_"^~"
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +32 ;
- +33 ; no code sheets to send
- +34 IF COUNT=0
- QUIT "0^No wr code sheets to send for this month"
- +35 ;
- +36 SET CR2="CR2^"_$EXTRACT(RCDATEND,2,3)_"^"_$EXTRACT(RCDATEND,4,5)_"^"_$EXTRACT(RCDATEND,6,7)
- +37 SET $PIECE(CR2,"^",10)="E"
- +38 SET $PIECE(CR2,"^",13)=999999999999
- +39 SET $PIECE(CR2,"^",15)=$JUSTIFY(DOCTOTAL,0,2)
- +40 SET $PIECE(CR2,"^",17)=$EXTRACT(RCDATEND,2,3)
- +41 SET $PIECE(CR2,"^",18)=$EXTRACT(RCDATEND,4,5)
- +42 SET $PIECE(CR2,"^",19)=$EXTRACT(RCDATEND,6,7)_"^~"
- +43 ;
- +44 ; put together document in gcs
- +45 NEW %DT,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
- +46 SET Y=$EXTRACT(RCDATEND,1,5)_"00"
- DO DD^%DT
- +47 SET DESCRIP="Monthly Write Off for "_Y
- +48 IF 'RCGECSDA
- DO CONTROL^GECSUFMS("A",$EXTRACT(RCTRANID,1,3),RCTRANID,"WR",10,0,"",DESCRIP)
- +49 IF RCGECSDA
- DO REBUILD^GECSUFM1(RCGECSDA,"A",10,"N","Rebuild "_DESCRIP)
- SET GECSFMS("DA")=RCGECSDA
- +50 ;
- +51 ; store document in gcs
- +52 DO SETCS^GECSSTAA(GECSFMS("DA"),CR2)
- +53 FOR COUNT=1:1
- if '$DATA(FMSLINE(COUNT))
- QUIT
- DO SETCS^GECSSTAA(GECSFMS("DA"),FMSLINE(COUNT))
- +54 DO SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
- +55 DO SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
- +56 ; set the key for lookup
- +57 DO SETKEY^GECSSTAA(GECSFMS("DA"),"WR-"_$EXTRACT(RCDATEND,1,5)_"00")
- +58 ;
- +59 ; return 1 for success ^ fms document transaction number
- +60 QUIT "1^WR-"_$PIECE(GECSFMS("CTL"),"^",9)
