source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCFMFN02.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1RCFMFN02 ;WASH-ISC@ATLOONA,PA/RGY-Return information for FMS Document processing ;8/27/94 8:40 PM
2V ;;4.5;Accounts Receivable;**114,204,173**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4DEL(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
11SSTAT(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
28GSTAT(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)
34RETN(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
44STSTAT(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
51GTSTAT(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 ;
57MAILREJ(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
Note: See TracBrowser for help on using the repository browser.