source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRJR.m@ 1556

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

initial load of WorldVistAEHR

File size: 4.3 KB
RevLine 
[613]1RCRJR ;WISC/RFJ,TJK-nightly process, monthly data extractors ;1 Mar 98
2 ;;4.5;Accounts Receivable;**101,103,78,153,191,239**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7START ; start the nightly process
8 ; called by PRCABJ
9 N X,Y
10 ;
11 ; if the 15th of the month, warn user of deletion
12 I $E(DT,6,7)=15 D CLEANXMB
13 ;
14 ; clean up old mailman messages on day 1
15 ; monthly transmission of reports on day 1
16 I +$E(DT,6,7)=$E($$LDATE(DT)+1,6,7) D
17 . ; clean up old mailman messages
18 . D CLEANXMB
19 . ; NDB and monthly FMS summary documents, bad debt report
20 . ; oig extract (end of quarter)
21 . D QUEUE("AR Data Collector","DQ^RCRJRCO")
22 ;
23 ; monthly transmission on the second to last workday
24 ;
25 ; Code commented out with patch PRCA*4.5*239
26 ; Allowances are now transmitted to FMS by the ARDC
27 ; when it runs on the third to last workday of month.
28 ;
29 ; I +$E(DT,6,7)=$E($$LDAY(DT),6,7) D
30 ; . ; bad debt report sent to FMS
31 ; . D QUEUE("Bad Debt Report","BADDEBT^RCXFMSSV")
32 ;
33 ; quarterly oig transaction report on 15th
34 I $E(DT,4,5)#3=1,$E(DT,6,7)=15 D QUEUE("AR OIG Transaction Extract","EN2^RCNRIG")
35 ;
36 ; reports sent on tuesday and thursdays (dmc)
37 S X=DT D DW^%DTC
38 I $E(X)="T" D
39 . ; dmc 90 day reports
40 . N ZTSAVE
41 . I '$O(^RC(342,0)) Q
42 . ; tUesday
43 . I $E(X,2)="U",$D(^RCD(340,"DMC")) D Q
44 . . S ZTSAVE("RCDOC")="W" D QUEUE("DMC 90 Day Reports","ENTER^RCDMC90")
45 . S X1=DT,X2=7 D C^%DTC I $E(DT,4,5)=$E(X,4,5) Q
46 . S ZTSAVE("RCDOC")="M" D QUEUE("DMC 90 Day Reports","ENTER^RCDMC90")
47 Q
48 ;
49 ;
50QUEUE(ZTDESC,ZTRTN) ; create taskmanager task
51 N %X,%Y,Y,ZTSK
52 S ZTIO="",ZTDTH=$H
53 D ^%ZTLOAD
54 D ^%ZISC
55 Q
56 ;
57 ;
58CLEANXMB ; clean up old mailman messages generated by AR
59 N SUBJECT,VERIFY
60 ;
61 ; delete the AR Data Collector Detail Report
62 S SUBJECT="ARDC Detail Report For "
63 S VERIFY="I $E(DATA,65)=""."",$E(DATA,76)=""."""
64 D GETXMZ(SUBJECT,VERIFY)
65 ;
66 ; delete the mccr ndb return reports
67 S SUBJECT="MCCR NDB Site "
68 S VERIFY="I $E(DATA,1,14)=""MCCR NDB Site """
69 D GETXMZ(SUBJECT,VERIFY)
70 ;
71 ; delete the nightly interest/admin/penalty messages
72 S SUBJECT="AR Nightly Interest/Admin/Pen"
73 S VERIFY="I $E(DATA,1,18)=""BILL DATEPREP"""
74 D GETXMZ(SUBJECT,VERIFY)
75 Q
76 ;
77 ;
78GETXMZ(RCSUBJCT,RCVERIFY) ; find a message to delete
79 ; loop through a subject, execute a check on the message, kill it
80 N DATA,RCSUBJ,RCXMZ
81 S RCSUBJ=RCSUBJCT
82 F S RCSUBJ=$O(^XMB(3.9,"B",RCSUBJ)) Q:$E(RCSUBJ,1,$L(RCSUBJCT))'=RCSUBJCT D
83 . S RCXMZ=0
84 . F S RCXMZ=$O(^XMB(3.9,"B",RCSUBJ,RCXMZ)) Q:'RCXMZ D
85 . . S DATA=$G(^XMB(3.9,RCXMZ,2,1,0))
86 . . X RCVERIFY
87 . . ; message found
88 . . I $T D
89 . . . ; if the current date is not the first, warn the user
90 . . . ; if the current date is the first, kill the message
91 . . . I $E(DT,6,7)'=$E($$LDATE(DT)+1,6,7) D WARNKILL(RCXMZ) Q
92 . . . ;
93 . . . ; only kill the message if it was created before the
94 . . . ; 15th day of the previous month (since no warning
95 . . . ; message would of been generated).
96 . . . I $P($$ZNODE^XMXUTIL2(RCXMZ),"^",3)>($E($$FMDIFF^XLFDT(DT,-1),1,5)_19.999999) Q
97 . . . ;
98 . . . D KILLXMZ(RCXMZ)
99 Q
100 ;
101 ;
102KILLXMZ(XMZ) ; kills a message and responses
103 N K,X,XMABORT,XMKILL,Y
104 S XMABORT=0,(XMKILL("MSG"),XMKILL("RESP"))=0
105 D KILL^XMA32A(XMZ,.XMKILL,XMABORT)
106 Q
107 ;
108 ;
109WARNKILL(RCXMZ) ; enter response to the message warning the user the message
110 ; will deleted on the first of the month
111 N %,%H,%I,I,MESSAGE,XMZ2,Y
112 ;
113 ; get the first of next month (add 30 days and reset day to 1)
114 ;S Y=$E($$FMADD^XLFDT(DT,30),1,5)_"01" D DD^%DT
115 S Y=$$LDATE(DT)+1 D DD^%DT
116 ; create response
117 S MESSAGE(1)="WARNING, This message will be deleted on "_Y_". Please save"
118 S MESSAGE(2)="the data in this message to an excel spreadsheet or word document"
119 S MESSAGE(3)="prior to "_Y_"."
120 S %=$$ENT^XMA2R(RCXMZ,"Message Deletion",.MESSAGE,"","AR Package")
121 Q
122LDATE(X) ; DETERMINE CUT-OFF DATE FOR THE MONTH
123 S X=$E(X,1,5)_$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(X,4,5))
124 I +$E(X,6,7)=28,$E(X,2,3)#4=0 S $E(X,6,7)=29
125 S X=$$WORKPLUS^XUWORKDY(X,-3)
126 Q X
127LDAY(X) ;SECOND LAST WORKDAY OF THE MONTH
128 S X=$E(X,1,5)_$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(X,4,5))
129 I +$E(X,6,7)=28,$E(X,2,3)#4=0 S $E(X,6,7)=29
130 S X=$$WORKPLUS^XUWORKDY(X,-1)
131 Q X
Note: See TracBrowser for help on using the repository browser.