- RCXFMSCR ;WISC/RFJ-fms cash receipt (cr) code sheet generator ;1 Oct 97
- ;;4.5;Accounts Receivable;**90,114,148,172,204,203,173,220,184,375**;Mar 20, 1995;Build 15
- ;;Per VHA Directive 6402, this routine should not be modified.
- Q
- ;
- BUILDCR(RCRECTDA,RCGECSDA,RCEFT) ; generate a cr/tr code sheet for a receipt
- ; rcgecsda is the ien for the gcs stack file 2100.1 for rebuilds
- ; rceft = 1 if processing CR for an EFT deposit (CR to rev src cd 8NZZ)
- ; = 2 if processing TR for the receipt detail relating to an EFT
- ; (TR from 528704/8NZZ to original fund/rsc)
- ;
- N AMOUNT,BILLDA,COUNT,CR2,DETAIL,DEPOSIT,DESCRIP,DOCTOTAL,FISCALYR,FMSTYPE,FUND,GECSFMS,LINE,RCDEPTDA,REVSRCE,TOTAL,TRANDA,TRANNUMB,UNAPPLY,UNAPPNUM,VENDORID,DEBIT
- ;
- ; build the lines for all payments on receipt
- S RCEFT=+$G(RCEFT)
- K ^TMP($J,"RCFMSCR") ; used for 215 report, not used here
- D FMSLINES^RCXFMSC1(RCRECTDA)
- K ^TMP($J,"RCFMSCR")
- ;
- ; unapplied payments to accounts
- S TRANDA=0 F S TRANDA=$O(^RCY(344,RCRECTDA,1,TRANDA)) Q:'TRANDA D
- . ; dollars applied in AR
- . I $P(^RCY(344,RCRECTDA,1,TRANDA,0),"^",5) Q
- . ; no dollars on transaction
- . S AMOUNT=$P(^RCY(344,RCRECTDA,1,TRANDA,0),"^",4) I 'AMOUNT Q
- . ;
- . ; PRCA*4.5*375 - If sending CR doc, check for debit; if debit, subtract amount instead of add
- . I RCEFT=1 D Q
- . . N DATE
- . . S DATE=$S(DT<3030926:"",DT'<3030926&(DT<$$ADDPTEDT^PRCAACC()):".4",1:"04")
- . . S:$P(^RCY(344,RCRECTDA,1,TRANDA,0),"^",29)="D" AMOUNT=-AMOUNT
- . . S TOTAL("5287"_DATE,"8NZZ","MCCFVALUE")=$G(TOTAL("5287"_$S(DT<3030926:"",1:"04"),"8NZZ","MCCFVALUE"))+AMOUNT
- . S UNAPPLY($$GETUNAPP(RCRECTDA,TRANDA,1))=AMOUNT
- ;
- ; no code sheets to send
- I '$D(DETAIL),'$D(TOTAL),'$D(UNAPPLY) Q "-1^No code sheets to send for this receipt"
- ;
- ; get the next common number in the series = station "-" nextnumber
- ; use (field 200 in file 344) if document previously sent
- S TRANNUMB=$P($P($G(^RCY(344,RCRECTDA,2)),"^"),"-",2)
- I TRANNUMB="" S TRANNUMB=$$ENUM^RCMSNUM
- I TRANNUMB<0 Q "0^Unable to lookup next transaction number"
- ; remove the dash (i,e, 460-K1A05HY)
- S TRANNUMB=$TR(TRANNUMB,"-")
- ;
- S FISCALYR=$$FY^RCFN01(DT)
- ;
- S COUNT=0,DOCTOTAL=0
- ; build detail line
- S FMSTYPE="" F S FMSTYPE=$O(DETAIL(FMSTYPE)) Q:FMSTYPE="" D
- . S BILLDA=0 F S BILLDA=$O(DETAIL(FMSTYPE,BILLDA)) Q:'BILLDA D
- . . S AMOUNT=DETAIL(FMSTYPE,BILLDA),DOCTOTAL=DOCTOTAL+AMOUNT
- . . S COUNT=COUNT+1
- . . S LINE(COUNT)="LIN^~CRA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
- . . S $P(LINE(COUNT),"^",20)=$J(AMOUNT,0,2)
- . . S $P(LINE(COUNT),"^",21)="I"
- . . S $P(LINE(COUNT),"^",23)=FMSTYPE
- . . S $P(LINE(COUNT),"^",24)="BD"
- . . S $P(LINE(COUNT),"^",25)=$TR($P(^PRCA(430,BILLDA,0),"^"),"-")
- . . S $P(LINE(COUNT),"^",26)=$$LINE^RCXFMSC1(BILLDA)
- . . S $P(LINE(COUNT),"^",27)="~"
- ;
- ; build summary line
- S FUND="" F S FUND=$O(TOTAL(FUND)) Q:FUND="" D
- . S REVSRCE="" F S REVSRCE=$O(TOTAL(FUND,REVSRCE)) Q:REVSRCE="" D
- . . S VENDORID="" F S VENDORID=$O(TOTAL(FUND,REVSRCE,VENDORID)) Q:VENDORID="" D
- . . . S AMOUNT=TOTAL(FUND,REVSRCE,VENDORID),DOCTOTAL=DOCTOTAL+AMOUNT
- . . . S DEBIT="" ; PRCA*4.5*375 - If negative amount, set debit flag
- . . . S:AMOUNT<0 DEBIT=1,AMOUNT=$FN(AMOUNT,"-") ; PRCA*4.5*375 - If negative amount, set debit flag
- . . . 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)=$S(FUND=4032:"03",1:FISCALYR)
- . . . S $P(LINE(COUNT),"^",4)=$S($E(FUND,1,4)=5287:"05",1:FISCALYR)
- . . . S $P(LINE(COUNT),"^",6)=FUND
- . . . S $P(LINE(COUNT),"^",7)=$E(TRANNUMB,1,3) ; station #
- . . . S $P(LINE(COUNT),"^",10)=REVSRCE
- . . . ;I FUND=4032 S $P(LINE(COUNT),"^",13)="24GX40100"
- . . . S $P(LINE(COUNT),"^",18)=VENDORID
- . . . S $P(LINE(COUNT),"^",20)=$J(AMOUNT,0,2)
- . . . S $P(LINE(COUNT),"^",21)=$S(DEBIT:"D",1:"I") ; PRCA*4.5*375 - Send Debit Flag if to FMS
- . . . S $P(LINE(COUNT),"^",23)=23
- . . . S $P(LINE(COUNT),"^",24)="~"
- ;
- ; build unapplied payment lines
- S UNAPPNUM="" F S UNAPPNUM=$O(UNAPPLY(UNAPPNUM)) Q:UNAPPNUM="" D
- . S AMOUNT=UNAPPLY(UNAPPNUM),DOCTOTAL=DOCTOTAL+AMOUNT
- . 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),"^",6)=3875
- . S $P(LINE(COUNT),"^",7)=$E(TRANNUMB,1,3) ; station #
- . S $P(LINE(COUNT),"^",20)=$J(AMOUNT,0,2)
- . S $P(LINE(COUNT),"^",21)="I"
- . S $P(LINE(COUNT),"^",23)=17
- . S $P(LINE(COUNT),"^",24)="~CRB"
- . S $P(LINE(COUNT),"^",32)=UNAPPNUM
- . S $P(LINE(COUNT),"^",33)="~"
- ;
- ; get data from file 344.1, the ar deposit file
- S RCDEPTDA=$P(^RCY(344,RCRECTDA,0),"^",6),DEPOSIT=$G(^RCY(344.1,RCDEPTDA,0))
- ;
- ; build cr2, $p(deposit,^,3)=deposit date
- N FMSDT S FMSDT=$$FMSDATE^RCBEUTRA(DT)
- S CR2="CR2^"_$E(FMSDT,2,3)_"^"_$E(FMSDT,4,5)_"^"_$E(FMSDT,6,7)_"^^^^^^E^^^"
- S CR2=CR2_$P(DEPOSIT,"^")_"^^"_$FN(DOCTOTAL,"-",2)_"^^" ; PRCA*4.5*375 - Suppress minus sign so we don't send negative values to FMS
- S CR2=CR2_$E($P(DEPOSIT,"^",3),2,3)_"^"_$E($P(DEPOSIT,"^",3),4,5)_"^"_$E($P(DEPOSIT,"^",3),6,7)_"^~"
- ;
- ; put together document in gcs
- N %DT,D,D0,DA,DI,DIC,DIE,DIQ2,DQ,DR
- S DESCRIP="Receipt: "_$P(^RCY(344,RCRECTDA,0),"^")
- I 'RCGECSDA D CONTROL^GECSUFMS("A",$E(TRANNUMB,1,3),TRANNUMB,"CR",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(LINE(COUNT)) D SETCS^GECSSTAA(GECSFMS("DA"),LINE(COUNT))
- D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
- D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
- ;
- ; add/update entry in file 347 for unprocessed document report
- N %DT,%X,D,DA347,D0,DI,DQ,DIC,ERROR,FMSDOCNO,X
- S FMSDOCNO="CR-"_$P(GECSFMS("CTL"),"^",9)
- S DA347=$O(^RC(347,"C",FMSDOCNO,0))
- ; if not in the file, addit fmsdocid cr id
- I 'DA347 D OPEN^RCFMDRV1(FMSDOCNO,3,"RC"_$P($G(^RCY(344,RCRECTDA,0)),"^"),.DA347,.ERROR)
- I DA347 D SSTAT^RCFMFN02(FMSDOCNO,1)
- ;
- ; return 1 for success ^ fms document transaction number
- Q "1^"_FMSDOCNO
- ;
- ;
- GETUNAPP(RCRECTDA,RCTRANDA,RCSTORE) ; get unapplied deposit number for receipt
- ; if $g(rcstore) store it with transaction
- N UNAPPNUM
- ; if number is already assigned, use it
- I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)'="" Q $P(^(2),"^",5)
- ;
- S UNAPPNUM=$P(^RCY(344,RCRECTDA,0),"^")
- ; if the receipt number is more than 9 characters, take the last 9
- I $L(UNAPPNUM)>9 S UNAPPNUM=$E(UNAPPNUM,$L(UNAPPNUM)-8,$L(UNAPPNUM))
- S UNAPPNUM=UNAPPNUM_$TR($J(RCTRANDA,4)," ",0)
- ;
- ; store unapplied number
- I $G(RCSTORE) D SETUNAPP^RCDPURET(RCRECTDA,RCTRANDA,UNAPPNUM)
- ;
- Q UNAPPNUM
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXFMSCR 7046 printed Jan 18, 2025@02:50:28 Page 2
- RCXFMSCR ;WISC/RFJ-fms cash receipt (cr) code sheet generator ;1 Oct 97
- +1 ;;4.5;Accounts Receivable;**90,114,148,172,204,203,173,220,184,375**;Mar 20, 1995;Build 15
- +2 ;;Per VHA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- BUILDCR(RCRECTDA,RCGECSDA,RCEFT) ; generate a cr/tr code sheet for a receipt
- +1 ; rcgecsda is the ien for the gcs stack file 2100.1 for rebuilds
- +2 ; rceft = 1 if processing CR for an EFT deposit (CR to rev src cd 8NZZ)
- +3 ; = 2 if processing TR for the receipt detail relating to an EFT
- +4 ; (TR from 528704/8NZZ to original fund/rsc)
- +5 ;
- +6 NEW AMOUNT,BILLDA,COUNT,CR2,DETAIL,DEPOSIT,DESCRIP,DOCTOTAL,FISCALYR,FMSTYPE,FUND,GECSFMS,LINE,RCDEPTDA,REVSRCE,TOTAL,TRANDA,TRANNUMB,UNAPPLY,UNAPPNUM,VENDORID,DEBIT
- +7 ;
- +8 ; build the lines for all payments on receipt
- +9 SET RCEFT=+$GET(RCEFT)
- +10 ; used for 215 report, not used here
- KILL ^TMP($JOB,"RCFMSCR")
- +11 DO FMSLINES^RCXFMSC1(RCRECTDA)
- +12 KILL ^TMP($JOB,"RCFMSCR")
- +13 ;
- +14 ; unapplied payments to accounts
- +15 SET TRANDA=0
- FOR
- SET TRANDA=$ORDER(^RCY(344,RCRECTDA,1,TRANDA))
- if 'TRANDA
- QUIT
- Begin DoDot:1
- +16 ; dollars applied in AR
- +17 IF $PIECE(^RCY(344,RCRECTDA,1,TRANDA,0),"^",5)
- QUIT
- +18 ; no dollars on transaction
- +19 SET AMOUNT=$PIECE(^RCY(344,RCRECTDA,1,TRANDA,0),"^",4)
- IF 'AMOUNT
- QUIT
- +20 ;
- +21 ; PRCA*4.5*375 - If sending CR doc, check for debit; if debit, subtract amount instead of add
- +22 IF RCEFT=1
- Begin DoDot:2
- +23 NEW DATE
- +24 SET DATE=$SELECT(DT<3030926:"",DT'<3030926&(DT<$$ADDPTEDT^PRCAACC()):".4",1:"04")
- +25 if $PIECE(^RCY(344,RCRECTDA,1,TRANDA,0),"^",29)="D"
- SET AMOUNT=-AMOUNT
- +26 SET TOTAL("5287"_DATE,"8NZZ","MCCFVALUE")=$GET(TOTAL("5287"_$SELECT(DT<3030926:"",1:"04"),"8NZZ","MCCFVALUE"))+AMOUNT
- End DoDot:2
- QUIT
- +27 SET UNAPPLY($$GETUNAPP(RCRECTDA,TRANDA,1))=AMOUNT
- End DoDot:1
- +28 ;
- +29 ; no code sheets to send
- +30 IF '$DATA(DETAIL)
- IF '$DATA(TOTAL)
- IF '$DATA(UNAPPLY)
- QUIT "-1^No code sheets to send for this receipt"
- +31 ;
- +32 ; get the next common number in the series = station "-" nextnumber
- +33 ; use (field 200 in file 344) if document previously sent
- +34 SET TRANNUMB=$PIECE($PIECE($GET(^RCY(344,RCRECTDA,2)),"^"),"-",2)
- +35 IF TRANNUMB=""
- SET TRANNUMB=$$ENUM^RCMSNUM
- +36 IF TRANNUMB<0
- QUIT "0^Unable to lookup next transaction number"
- +37 ; remove the dash (i,e, 460-K1A05HY)
- +38 SET TRANNUMB=$TRANSLATE(TRANNUMB,"-")
- +39 ;
- +40 SET FISCALYR=$$FY^RCFN01(DT)
- +41 ;
- +42 SET COUNT=0
- SET DOCTOTAL=0
- +43 ; build detail line
- +44 SET FMSTYPE=""
- FOR
- SET FMSTYPE=$ORDER(DETAIL(FMSTYPE))
- if FMSTYPE=""
- QUIT
- Begin DoDot:1
- +45 SET BILLDA=0
- FOR
- SET BILLDA=$ORDER(DETAIL(FMSTYPE,BILLDA))
- if 'BILLDA
- QUIT
- Begin DoDot:2
- +46 SET AMOUNT=DETAIL(FMSTYPE,BILLDA)
- SET DOCTOTAL=DOCTOTAL+AMOUNT
- +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),"^",20)=$JUSTIFY(AMOUNT,0,2)
- +50 SET $PIECE(LINE(COUNT),"^",21)="I"
- +51 SET $PIECE(LINE(COUNT),"^",23)=FMSTYPE
- +52 SET $PIECE(LINE(COUNT),"^",24)="BD"
- +53 SET $PIECE(LINE(COUNT),"^",25)=$TRANSLATE($PIECE(^PRCA(430,BILLDA,0),"^"),"-")
- +54 SET $PIECE(LINE(COUNT),"^",26)=$$LINE^RCXFMSC1(BILLDA)
- +55 SET $PIECE(LINE(COUNT),"^",27)="~"
- End DoDot:2
- End DoDot:1
- +56 ;
- +57 ; build summary line
- +58 SET FUND=""
- FOR
- SET FUND=$ORDER(TOTAL(FUND))
- if FUND=""
- QUIT
- Begin DoDot:1
- +59 SET REVSRCE=""
- FOR
- SET REVSRCE=$ORDER(TOTAL(FUND,REVSRCE))
- if REVSRCE=""
- QUIT
- Begin DoDot:2
- +60 SET VENDORID=""
- FOR
- SET VENDORID=$ORDER(TOTAL(FUND,REVSRCE,VENDORID))
- if VENDORID=""
- QUIT
- Begin DoDot:3
- +61 SET AMOUNT=TOTAL(FUND,REVSRCE,VENDORID)
- SET DOCTOTAL=DOCTOTAL+AMOUNT
- +62 ; PRCA*4.5*375 - If negative amount, set debit flag
- SET DEBIT=""
- +63 ; PRCA*4.5*375 - If negative amount, set debit flag
- if AMOUNT<0
- SET DEBIT=1
- SET AMOUNT=$FNUMBER(AMOUNT,"-")
- +64 SET COUNT=COUNT+1
- +65 SET LINE(COUNT)="LIN^~CRA^"_$SELECT($LENGTH(COUNT)=1:"00",$LENGTH(COUNT)=2:"0",1:"")_COUNT
- +66 SET $PIECE(LINE(COUNT),"^",4)=$SELECT(FUND=4032:"03",1:FISCALYR)
- +67 SET $PIECE(LINE(COUNT),"^",4)=$SELECT($EXTRACT(FUND,1,4)=5287:"05",1:FISCALYR)
- +68 SET $PIECE(LINE(COUNT),"^",6)=FUND
- +69 ; station #
- SET $PIECE(LINE(COUNT),"^",7)=$EXTRACT(TRANNUMB,1,3)
- +70 SET $PIECE(LINE(COUNT),"^",10)=REVSRCE
- +71 ;I FUND=4032 S $P(LINE(COUNT),"^",13)="24GX40100"
- +72 SET $PIECE(LINE(COUNT),"^",18)=VENDORID
- +73 SET $PIECE(LINE(COUNT),"^",20)=$JUSTIFY(AMOUNT,0,2)
- +74 ; PRCA*4.5*375 - Send Debit Flag if to FMS
- SET $PIECE(LINE(COUNT),"^",21)=$SELECT(DEBIT:"D",1:"I")
- +75 SET $PIECE(LINE(COUNT),"^",23)=23
- +76 SET $PIECE(LINE(COUNT),"^",24)="~"
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +77 ;
- +78 ; build unapplied payment lines
- +79 SET UNAPPNUM=""
- FOR
- SET UNAPPNUM=$ORDER(UNAPPLY(UNAPPNUM))
- if UNAPPNUM=""
- QUIT
- Begin DoDot:1
- +80 SET AMOUNT=UNAPPLY(UNAPPNUM)
- SET DOCTOTAL=DOCTOTAL+AMOUNT
- +81 SET COUNT=COUNT+1
- +82 SET LINE(COUNT)="LIN^~CRA^"_$SELECT($LENGTH(COUNT)=1:"00",$LENGTH(COUNT)=2:"0",1:"")_COUNT
- +83 SET $PIECE(LINE(COUNT),"^",4)=FISCALYR
- +84 SET $PIECE(LINE(COUNT),"^",6)=3875
- +85 ; station #
- SET $PIECE(LINE(COUNT),"^",7)=$EXTRACT(TRANNUMB,1,3)
- +86 SET $PIECE(LINE(COUNT),"^",20)=$JUSTIFY(AMOUNT,0,2)
- +87 SET $PIECE(LINE(COUNT),"^",21)="I"
- +88 SET $PIECE(LINE(COUNT),"^",23)=17
- +89 SET $PIECE(LINE(COUNT),"^",24)="~CRB"
- +90 SET $PIECE(LINE(COUNT),"^",32)=UNAPPNUM
- +91 SET $PIECE(LINE(COUNT),"^",33)="~"
- End DoDot:1
- +92 ;
- +93 ; get data from file 344.1, the ar deposit file
- +94 SET RCDEPTDA=$PIECE(^RCY(344,RCRECTDA,0),"^",6)
- SET DEPOSIT=$GET(^RCY(344.1,RCDEPTDA,0))
- +95 ;
- +96 ; build cr2, $p(deposit,^,3)=deposit date
- +97 NEW FMSDT
- SET FMSDT=$$FMSDATE^RCBEUTRA(DT)
- +98 SET CR2="CR2^"_$EXTRACT(FMSDT,2,3)_"^"_$EXTRACT(FMSDT,4,5)_"^"_$EXTRACT(FMSDT,6,7)_"^^^^^^E^^^"
- +99 ; PRCA*4.5*375 - Suppress minus sign so we don't send negative values to FMS
- SET CR2=CR2_$PIECE(DEPOSIT,"^")_"^^"_$FNUMBER(DOCTOTAL,"-",2)_"^^"
- +100 SET CR2=CR2_$EXTRACT($PIECE(DEPOSIT,"^",3),2,3)_"^"_$EXTRACT($PIECE(DEPOSIT,"^",3),4,5)_"^"_$EXTRACT($PIECE(DEPOSIT,"^",3),6,7)_"^~"
- +101 ;
- +102 ; put together document in gcs
- +103 NEW %DT,D,D0,DA,DI,DIC,DIE,DIQ2,DQ,DR
- +104 SET DESCRIP="Receipt: "_$PIECE(^RCY(344,RCRECTDA,0),"^")
- +105 IF 'RCGECSDA
- DO CONTROL^GECSUFMS("A",$EXTRACT(TRANNUMB,1,3),TRANNUMB,"CR",10,0,"",DESCRIP)
- +106 IF RCGECSDA
- DO REBUILD^GECSUFM1(RCGECSDA,"A",10,"N","Rebuild "_DESCRIP)
- SET GECSFMS("DA")=RCGECSDA
- +107 ;
- +108 ; store document in gcs
- +109 DO SETCS^GECSSTAA(GECSFMS("DA"),CR2)
- +110 FOR COUNT=1:1
- if '$DATA(LINE(COUNT))
- QUIT
- DO SETCS^GECSSTAA(GECSFMS("DA"),LINE(COUNT))
- +111 DO SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
- +112 DO SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
- +113 ;
- +114 ; add/update entry in file 347 for unprocessed document report
- +115 NEW %DT,%X,D,DA347,D0,DI,DQ,DIC,ERROR,FMSDOCNO,X
- +116 SET FMSDOCNO="CR-"_$PIECE(GECSFMS("CTL"),"^",9)
- +117 SET DA347=$ORDER(^RC(347,"C",FMSDOCNO,0))
- +118 ; if not in the file, addit fmsdocid cr id
- +119 IF 'DA347
- DO OPEN^RCFMDRV1(FMSDOCNO,3,"RC"_$PIECE($GET(^RCY(344,RCRECTDA,0)),"^"),.DA347,.ERROR)
- +120 IF DA347
- DO SSTAT^RCFMFN02(FMSDOCNO,1)
- +121 ;
- +122 ; return 1 for success ^ fms document transaction number
- +123 QUIT "1^"_FMSDOCNO
- +124 ;
- +125 ;
- GETUNAPP(RCRECTDA,RCTRANDA,RCSTORE) ; get unapplied deposit number for receipt
- +1 ; if $g(rcstore) store it with transaction
- +2 NEW UNAPPNUM
- +3 ; if number is already assigned, use it
- +4 IF $PIECE($GET(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)'=""
- QUIT $PIECE(^(2),"^",5)
- +5 ;
- +6 SET UNAPPNUM=$PIECE(^RCY(344,RCRECTDA,0),"^")
- +7 ; if the receipt number is more than 9 characters, take the last 9
- +8 IF $LENGTH(UNAPPNUM)>9
- SET UNAPPNUM=$EXTRACT(UNAPPNUM,$LENGTH(UNAPPNUM)-8,$LENGTH(UNAPPNUM))
- +9 SET UNAPPNUM=UNAPPNUM_$TRANSLATE($JUSTIFY(RCTRANDA,4)," ",0)
- +10 ;
- +11 ; store unapplied number
- +12 IF $GET(RCSTORE)
- DO SETUNAPP^RCDPURET(RCRECTDA,RCTRANDA,UNAPPNUM)
- +13 ;
- +14 QUIT UNAPPNUM