| [613] | 1 | RCFMFN02 ;WASH-ISC@ATLOONA,PA/RGY-Return information for FMS Document processing ;8/27/94 8:40 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**114,204,173**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | DEL(ID) ;Delete entry from DOCUMENT file (347)
|
|---|
| 5 | NEW DA
|
|---|
| 6 | I '$D(ID) Q
|
|---|
| 7 | S DA=+$O(^RC(347,"C",ID,0)) S:'DA DA=+$O(^RC(347,"D",ID,0))
|
|---|
| 8 | I '$D(^RC(347,DA,0)) Q
|
|---|
| 9 | D DEL^RCFMPUR(DA)
|
|---|
| 10 | Q
|
|---|
| 11 | SSTAT(ID,STAT) ;Set status for DOCUMENT file (347)
|
|---|
| 12 | NEW %DT,D,D0,DA,DI,DIC,DIE,DQ,DR,X
|
|---|
| 13 | I '$D(ID) Q
|
|---|
| 14 | S DA=+$O(^RC(347,"C",ID,0)) S:'DA DA=+$O(^RC(347,"D",ID,0))
|
|---|
| 15 | I '$D(^RC(347,DA,0)) Q
|
|---|
| 16 | I ",0,1,2,3,"'[(","_$G(STAT)_",") Q
|
|---|
| 17 | S DIE="^RC(347,",DR=".05///^S X=""NOW"";.03////^S X="_STAT D ^DIE
|
|---|
| 18 | ;Update the FMS TRAMSISSION DATE in files 430 and 347
|
|---|
| 19 | S FMSDT=$S($G(FMSDT):FMSDT,1:DT)
|
|---|
| 20 | ;DA is already set above
|
|---|
| 21 | I $D(^RC(347,DA,2)) K ^RC(347,"FMS",^RC(347,DA,2),DA)
|
|---|
| 22 | S ^RC(347,DA,2)=FMSDT,^RC(347,"FMS",FMSDT,DA)=""
|
|---|
| 23 | ;need to set DA for file 430... from the AR Bill number from file 347.
|
|---|
| 24 | S DA=$P($G(^RC(347,DA,0)),"^",7) I DA D
|
|---|
| 25 | .I $D(^PRCA(430,DA,203)) K ^PRCA(430,"FMS",^PRCA(430,DA,203),DA)
|
|---|
| 26 | .S ^PRCA(430,DA,203)=FMSDT,^PRCA(430,"FMS",FMSDT,DA)=""
|
|---|
| 27 | Q
|
|---|
| 28 | GSTAT(ID) ;Get status for DOCUMENT file (347)
|
|---|
| 29 | NEW DA
|
|---|
| 30 | I '$D(ID) Q -1
|
|---|
| 31 | S DA=+$O(^RC(347,"C",ID,0)) S:'DA DA=+$O(^RC(347,"D",ID,0))
|
|---|
| 32 | I '$D(^RC(347,DA,0)) Q -1
|
|---|
| 33 | Q $P(^RC(347,DA,0),"^",3)
|
|---|
| 34 | RETN(ID,ST) ;Process return document from stacker
|
|---|
| 35 | NEW DA
|
|---|
| 36 | I '$D(ID) Q
|
|---|
| 37 | ;line removed to accomodate full fms doc number - CLH
|
|---|
| 38 | S ST=$G(ST),ST=$S(ST="A":2,ST="R":3,1:-1)
|
|---|
| 39 | I ST<0 Q
|
|---|
| 40 | ; if a CR document and it rejects, send message to users
|
|---|
| 41 | I $S($E(ID,1,3)="CR-":1,$E(ID,1,3)="TR-":1,1:0),ST=3 D MAILREJ(ID)
|
|---|
| 42 | D SSTAT(ID,ST)
|
|---|
| 43 | Q
|
|---|
| 44 | STSTAT(DA,ST) ;set processed status in 433 (used for summary docs)
|
|---|
| 45 | Q:'$D(DA)
|
|---|
| 46 | Q:'$D(ST)
|
|---|
| 47 | Q:'$D(^PRCA(433,DA,0))
|
|---|
| 48 | N DIE,DR
|
|---|
| 49 | S DIE="^PRCA(433,",DR="91///^S X="_ST D ^DIE
|
|---|
| 50 | Q
|
|---|
| 51 | GTSTAT(DA) ;function to return transaction status
|
|---|
| 52 | I DA<0 Q -1
|
|---|
| 53 | I '$D(^PRCA(433,DA,8)) Q -1
|
|---|
| 54 | Q $P(^PRCA(433,DA,0),U,9)
|
|---|
| 55 | ;
|
|---|
| 56 | ;
|
|---|
| 57 | MAILREJ(DOCUMENT) ; mail reject message to user to ask for retransmission
|
|---|
| 58 | N MESSAGE,RECEIPT,XCNP,XMDUZ,XMZ,RCCR
|
|---|
| 59 | S RCCR=$S($E(DOCUMENT,1,3)="CR-":1,$E(DOCUMENT,1,4)="TR-":2,1:0)
|
|---|
| 60 | S MESSAGE(1)="The following "_$E(DOCUMENT,1,2)_" FMS document rejected and needs to be retransmitted."
|
|---|
| 61 | S MESSAGE(2)=" "
|
|---|
| 62 | S MESSAGE(3)=" Document: "_DOCUMENT
|
|---|
| 63 | S MESSAGE(4)=" "
|
|---|
| 64 | ; show information for cash receipt/transfer receipt for EDI document
|
|---|
| 65 | I RCCR D
|
|---|
| 66 | . S MESSAGE(5)="You may regenerate this "_$P("cash^transfer",U,RCCR)_" receipt document by selecting the"
|
|---|
| 67 | . S MESSAGE(6)="option Process Receipt (PR) located under the Receipt Processing"
|
|---|
| 68 | . S MESSAGE(7)="Listmanager screen."
|
|---|
| 69 | . S RECEIPT=$P($G(^RCY(344,+$O(^RCY(344,"ADOC",DOCUMENT,0)),0)),"^")
|
|---|
| 70 | . I RECEIPT'="" S MESSAGE(8)=" ",MESSAGE(9)=" This "_$P("cash^transfer",U,RCCR)_" receipt document was generated by receipt "_RECEIPT_"."
|
|---|
| 71 | ;
|
|---|
| 72 | S XMTEXT="MESSAGE("
|
|---|
| 73 | S XMSUB="FMS "_$S(RCCR'=2:"Cash",1:"Transfer")_" Receipt Document Rejected"
|
|---|
| 74 | S XMDUZ="AR Package",XMY("G.RCDP PAYMENTS")=""
|
|---|
| 75 | D ^XMD
|
|---|
| 76 | Q
|
|---|
