source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPUT.m@ 975

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1RCDPUT ;WASH-ISC@ALTOONA,PA/RGY-UTILITIES ;3/3/95 10:13 AM
2V ;;4.5;Accounts Receivable;**69,90,106,114,169**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7RECEIPTS ; check receipts
8 N DATA,PAYDA,RCCOUNT,RCDATA0,RCDATE,RCRECTDA,STATUS,TOTAL,X,XCNP,XMDUZ,XMZ
9 K ^TMP("RCDPUT",$J)
10 ; check receipts which are 4 days old
11 S RCDATE=$$FMADD^XLFDT(DT,-4)
12 S RCCOUNT=7
13 S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,RCRECTDA)) Q:'RCRECTDA D
14 . ; if no payments, quit
15 . I '$O(^RCY(344,RCRECTDA,1,0)) Q
16 . ;
17 . S RCDATA0=$G(^RCY(344,RCRECTDA,0))
18 . ;
19 . ; receipt is marked as processed
20 . I $P(RCDATA0,"^",8) D Q
21 . . ; check the last payment and see if it was processed
22 . . ; the last payment must have a paid amount and no processed
23 . . ; amount AND the payment did not go to suspense.
24 . . S PAYDA=9999999,TOTAL=0
25 . . F S PAYDA=$O(^RCY(344,RCRECTDA,1,PAYDA),-1) Q:'PAYDA S DATA=$G(^RCY(344,RCRECTDA,1,PAYDA,0)),TOTAL=TOTAL+$P(DATA,"^",4) I $P(DATA,"^",4),$P(DATA,"^",3),$P($G(^RCY(344,RCRECTDA,1,PAYDA,2)),"^",5)="" Q
26 . . ; no total paid on the receipt
27 . . I 'TOTAL Q
28 . . ; found the last payment and it is not processed
29 . . I PAYDA,'$P(^RCY(344,RCRECTDA,1,PAYDA,0),"^",5) D BUILDLN(RCDATA0,"All payments NOT completely processed.") Q
30 . . ;
31 . . ; if no deposit ticket, receipt is processed
32 . . I '$P(RCDATA0,"^",6) Q
33 . . ;
34 . . ; receipts is marked as entered on line
35 . . I $P($G(^RCY(344,RCRECTDA,2)),"^",2)=1 Q
36 . . ;
37 . . ; fms document has not been sent
38 . . I $P($G(^RCY(344,RCRECTDA,2)),"^")="" D BUILDLN(RCDATA0,"CR has NOT been sent to FMS.") Q
39 . . ;
40 . . ; get the status of the fms code sheet and see if it is
41 . . ; accepted
42 . . S STATUS=$$FMSSTAT^RCDPUREC(RCRECTDA)
43 . . ; document is accepted or entered on line
44 . . I $E($P(STATUS,"^",2))="A" Q
45 . . I $E($P(STATUS,"^",2))="O" Q
46 . . ; not been more than 4 days
47 . . I $$FMDIFF^XLFDT(DT,$P(RCDATA0,"^",8))<4 Q
48 . . D BUILDLN(RCDATA0,"CR NOT accepted in FMS ("_$P(STATUS," ")_").")
49 . ;
50 . ; receipt not that old
51 . I $P(RCDATA0,"^",3)>RCDATE Q
52 . ;
53 . ; not processed in a timely manner
54 . D BUILDLN(RCDATA0,"NOT processed in a timely manner.")
55 ;
56 I '$O(^TMP("RCDPUT",$J,0)) Q
57 ;
58 ; send mail message
59 S ^TMP("RCDPUT",$J,1)="Sent to: PRCA ERROR mailgroup"
60 S ^TMP("RCDPUT",$J,2)=" RCDP PAYMENTS mailgroup"
61 S ^TMP("RCDPUT",$J,3)=" PRCAY PAYMENT SUP security key holders"
62 S ^TMP("RCDPUT",$J,4)=" "
63 S ^TMP("RCDPUT",$J,5)="RECEIPT OPENED PROCESS WARNING"
64 S ^TMP("RCDPUT",$J,6)="------------------------------------------------------------------------------"
65 S XMY("G.PRCA ERROR")=""
66 S XMY("G.RCDP PAYMENTS")=""
67 F X=0:0 S X=$O(^XUSEC("PRCAY PAYMENT SUP",X)) Q:'X S XMY(X)=""
68 S XMDUZ="Accounts Receivable Package"
69 S XMTEXT="^TMP(""RCDPUT"",$J,"
70 S XMSUB="Error in Agent Cashier Receipt(s)"
71 D ^XMD
72 K ^TMP("RCDPUT",$J)
73 Q
74 ;
75 ;
76BUILDLN(RCDATA0,WARNING) ; build line in mail message with receipt data
77 N DATA,DATE
78 S RCCOUNT=RCCOUNT+1
79 S DATA=$E($P(RCDATA0,"^")_" ",1,11)_" "
80 S DATE=$P(RCDATA0,"^",3) I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
81 S DATA=DATA_$E(DATE_" ",1,8)_" "
82 S DATE=$P(RCDATA0,"^",8) I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
83 S DATA=DATA_$E(DATE_" ",1,8)_" "
84 S DATA=DATA_WARNING
85 S RCCOUNT=RCCOUNT+1
86 S ^TMP("RCDPUT",$J,RCCOUNT)=DATA
87 Q
88 ;
89 ;
90PURGE ; purge receipts and deposits
91 N %,D0,D1,DA,DG,DIC,DICR,DIG,DIH,DIK,DIU,DIV,DIW,RCDATE,RCDEPDA,RCRECTDA,X,Y
92 ;
93 ; purge receipts
94 S RCDATE=$$FPS^RCAMFN01(DT,-12)
95 S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,RCRECTDA)) Q:'RCRECTDA D
96 . ; receipt not processed, do not purge
97 . I '$P(^RCY(344,RCRECTDA,0),"^",8) Q
98 . ; receipt processed less than 12 months ago, do not purge
99 . I $P(^RCY(344,RCRECTDA,0),"^",8)>RCDATE Q
100 . ; purge receipt
101 . L +^RCY(344,RCRECTDA,0)
102 . S DIK="^RCY(344,",DA=RCRECTDA D ^DIK
103 . L -^RCY(344,RCRECTDA,0)
104 ;
105 ; purge deposits
106 S RCDATE=$$FPS^RCAMFN01(DT,-12)
107 S RCDEPDA=0 F S RCDEPDA=$O(^RCY(344.1,RCDEPDA)) Q:'RCDEPDA D
108 . ; if receipts are on deposit, do not purge
109 . I $O(^RCY(344,"AD",RCDEPDA,0)) Q
110 . ; deposit not confirmed, do not purge
111 . I '$P(^RCY(344.1,RCDEPDA,0),"^",11) Q
112 . ; deposit confirmed less than 12 months ago, do not purge
113 . I $P(^RCY(344.1,RCDEPDA,0),"^",11)>RCDATE Q
114 . ; purge deposit
115 . L +^RCY(344.1,RCDEPDA,0)
116 . S DIK="^RCY(344.1,",DA=RCDEPDA D ^DIK
117 . L -^RCY(344.1,RCDEPDA,0)
118 Q
119 ;
120 ;
121MAN ; Entry point for nightly process for managing receipts and deposits
122 D PURGE
123 D RECEIPTS
124 Q
Note: See TracBrowser for help on using the repository browser.