| 1 | PRCAFWO ;WASH-ISC@ALTOONA,PA/CLH-FMS WRITE OFF DOCUMENT ;8/2/95 3:20 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**16,48,89,90,204**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN(BN,DATE,AMOUNT,SITE,TN) ;entry point for auto-creation of FMS write off document
|
|---|
| 5 | NEW GECSFMS,FMSNUM,DA,TYPE,NUM,FMSNUM1 KILL ^TMP("PRCAWR",$J)
|
|---|
| 6 | SET NUM=$PIECE(^PRCA(430,BN,0),U),NUM=$PIECE(NUM,"-")_$PIECE(NUM,"-",2)
|
|---|
| 7 | SET FMSNUM=$$ENUM^RCMSNUM
|
|---|
| 8 | SET TYPE=$$RECTYP^PRCAFUT(BN)
|
|---|
| 9 | DO CONTROL^GECSUFMS("A",SITE,FMSNUM,"WR",10,"","N","WRITE OFF")
|
|---|
| 10 | S FMSNUM1=$P($G(GECSFMS("DOC")),U,3)_"-"_$P($G(GECSFMS("DOC")),U,4)
|
|---|
| 11 | DO OPEN^RCFMDRV1(FMSNUM1,1,"T"_TN,.ENT,.ERR,BN,TN)
|
|---|
| 12 | N FMSDT S FMSDT=$$FMSDATE^RCBEUTRA(DT)
|
|---|
| 13 | SET ^TMP("PRCAWR",$J,1)="CR2^"_$EXTRACT(FMSDT,2,3)_U_$EXTRACT(FMSDT,4,5)_U_$EXTRACT(FMSDT,6,7)_"^^^^^^E^^^999999999999^^"_$JUSTIFY(AMOUNT,0,2)_"^^"_$EXTRACT(DT,2,3)_U_$EXTRACT(DT,4,5)_U_$EXTRACT(DT,6,7)_"^~"
|
|---|
| 14 | I "^30^32^"[("^"_$P($G(^PRCA(430,+BN,0)),"^",2)_"^") S $P(^TMP("PRCAWR",$J,1),"^",15)=$TR($P(^TMP("PRCAWR",$J,1),"^",15),"-","")
|
|---|
| 15 | SET ^TMP("PRCAWR",$J,2)="LIN^~"
|
|---|
| 16 | SET ^TMP("PRCAWR",$J,3)="CRA^001^^^^^^^^^^^^^^^^^"_$JUSTIFY(AMOUNT,0,2)_"^I^^"_$P($$DTYPE^PRCAFBD1(TYPE),U,4)_"^BD^"_NUM_"^"_$$LINE^RCXFMSC1(BN)_"^~"
|
|---|
| 17 | ;Tricare document
|
|---|
| 18 | I "^30^32^"[("^"_$P($G(^PRCA(430,+BN,0)),"^",2)_"^") S $P(^TMP("PRCAWR",$J,3),"^",22)="06",$P(^TMP("PRCAWR",$J,3),"^",19)=$TR($P(^TMP("PRCAWR",$J,3),"^",19),"-","")
|
|---|
| 19 | SET DA=0 FOR SET DA=$ORDER(^TMP("PRCAWR",$J,DA)) QUIT:'DA DO SETCS^GECSSTAA(GECSFMS("DA"),^(DA))
|
|---|
| 20 | DO SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
|
|---|
| 21 | DO SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
|
|---|
| 22 | DO SSTAT^RCFMFN02("T"_TN,1)
|
|---|
| 23 | WRITE !,"WRITE OFF Document Created. Number # ",GECSFMS("DA"),".",!
|
|---|
| 24 | SET $PIECE(^PRCA(430,BN,11),U,22)=$P(FMSNUM,"-")_$P(FMSNUM,"-",2)
|
|---|
| 25 | KILL ^TMP("PRCAWR",$J)
|
|---|
| 26 | QUIT
|
|---|
| 27 | ;
|
|---|
| 28 | MODWR(BN,AMOUNT,FMSNUM,TN,MOD) ;send modified write-off document
|
|---|
| 29 | W !!,"Creating Modified WR document..."
|
|---|
| 30 | NEW GECSFMS,DA,TYPE,NUM,FMSNUM1 KILL ^TMP("PRCAWR",$J)
|
|---|
| 31 | S NUM=$P(^PRCA(430,BN,0),U),NUM=$P(NUM,"-")_$P(NUM,"-",2)
|
|---|
| 32 | S TYPE=$$RECTYP^PRCAFUT(BN)
|
|---|
| 33 | D CONTROL^GECSUFMS("A",$$SITE^RCMSITE,FMSNUM,"WR",10,$S(MOD=1:1,1:""),"N","MODIFIED WRITE OFF")
|
|---|
| 34 | I MOD S FMSNUM1=$P($G(GECSFMS("DOC")),U,3)_"-"_$P($G(GECSFMS("DOC")),U,4)_"-"_$P($G(GECSFMS("BAT")),U,3)
|
|---|
| 35 | D OPEN^RCFMDRV1($S($D(FMSNUM1):FMSNUM1,1:FMSNUM),1,"T"_TN,.ENT,.ERR,BN,TN)
|
|---|
| 36 | N FMSDT S FMSDT=$$FMSDATE^RCBEUTRA(DT)
|
|---|
| 37 | S ^TMP("PRCAWR",$J,1)="CR2^"_$E(FMSDT,2,3)_U_$E(FMSDT,4,5)_U_$E(FMSDT,6,7)_"^^^^^^M^^^999999999999^^"_$J(AMOUNT,0,2)_"^^"_$E(DT,2,3)_U_$E(DT,4,5)_U_$E(DT,6,7)_"^~"
|
|---|
| 38 | S ^TMP("PRCAWR",$J,2)="LIN^~"
|
|---|
| 39 | S ^TMP("PRCAWR",$J,3)="CRA^001^^^^^^^^^^^^^^^^^"_$J(AMOUNT,0,2)_"^D^^"_$P($$DTYPE^PRCAFBD1(TYPE),U,4)_"^BD^"_NUM_"^"_$$LINE^RCXFMSC1(BN)_"^~"
|
|---|
| 40 | S DA=0 FOR S DA=$O(^TMP("PRCAWR",$J,DA)) Q:'DA D SETCS^GECSSTAA(GECSFMS("DA"),^(DA))
|
|---|
| 41 | D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
|
|---|
| 42 | D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
|
|---|
| 43 | D SSTAT^RCFMFN02("T"_TN,1)
|
|---|
| 44 | W !,"Document Created. Number # ",GECSFMS("DA"),".",!
|
|---|
| 45 | I '$G(REFMS)&(DT>$$LDATE^RCRJR(DT)) S Y=$E($$FPS^RCAMFN01(DT,1),1,5)_"01" D DD^%DT W !!," * * * * Transmission will be held until "_Y_" * * * *"
|
|---|
| 46 | S $P(^PRCA(430,BN,11),U,22)=FMSNUM
|
|---|
| 47 | K ^TMP("PRCAWR",$J)
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
