132 lines
4.3 KiB
Mathematica
132 lines
4.3 KiB
Mathematica
RCRJR ;WISC/RFJ,TJK-nightly process, monthly data extractors ;1 Mar 98
|
|
;;4.5;Accounts Receivable;**101,103,78,153,191,239**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
START ; start the nightly process
|
|
; called by PRCABJ
|
|
N X,Y
|
|
;
|
|
; if the 15th of the month, warn user of deletion
|
|
I $E(DT,6,7)=15 D CLEANXMB
|
|
;
|
|
; clean up old mailman messages on day 1
|
|
; monthly transmission of reports on day 1
|
|
I +$E(DT,6,7)=$E($$LDATE(DT)+1,6,7) D
|
|
. ; clean up old mailman messages
|
|
. D CLEANXMB
|
|
. ; NDB and monthly FMS summary documents, bad debt report
|
|
. ; oig extract (end of quarter)
|
|
. D QUEUE("AR Data Collector","DQ^RCRJRCO")
|
|
;
|
|
; monthly transmission on the second to last workday
|
|
;
|
|
; Code commented out with patch PRCA*4.5*239
|
|
; Allowances are now transmitted to FMS by the ARDC
|
|
; when it runs on the third to last workday of month.
|
|
;
|
|
; I +$E(DT,6,7)=$E($$LDAY(DT),6,7) D
|
|
; . ; bad debt report sent to FMS
|
|
; . D QUEUE("Bad Debt Report","BADDEBT^RCXFMSSV")
|
|
;
|
|
; quarterly oig transaction report on 15th
|
|
I $E(DT,4,5)#3=1,$E(DT,6,7)=15 D QUEUE("AR OIG Transaction Extract","EN2^RCNRIG")
|
|
;
|
|
; reports sent on tuesday and thursdays (dmc)
|
|
S X=DT D DW^%DTC
|
|
I $E(X)="T" D
|
|
. ; dmc 90 day reports
|
|
. N ZTSAVE
|
|
. I '$O(^RC(342,0)) Q
|
|
. ; tUesday
|
|
. I $E(X,2)="U",$D(^RCD(340,"DMC")) D Q
|
|
. . S ZTSAVE("RCDOC")="W" D QUEUE("DMC 90 Day Reports","ENTER^RCDMC90")
|
|
. S X1=DT,X2=7 D C^%DTC I $E(DT,4,5)=$E(X,4,5) Q
|
|
. S ZTSAVE("RCDOC")="M" D QUEUE("DMC 90 Day Reports","ENTER^RCDMC90")
|
|
Q
|
|
;
|
|
;
|
|
QUEUE(ZTDESC,ZTRTN) ; create taskmanager task
|
|
N %X,%Y,Y,ZTSK
|
|
S ZTIO="",ZTDTH=$H
|
|
D ^%ZTLOAD
|
|
D ^%ZISC
|
|
Q
|
|
;
|
|
;
|
|
CLEANXMB ; clean up old mailman messages generated by AR
|
|
N SUBJECT,VERIFY
|
|
;
|
|
; delete the AR Data Collector Detail Report
|
|
S SUBJECT="ARDC Detail Report For "
|
|
S VERIFY="I $E(DATA,65)=""."",$E(DATA,76)=""."""
|
|
D GETXMZ(SUBJECT,VERIFY)
|
|
;
|
|
; delete the mccr ndb return reports
|
|
S SUBJECT="MCCR NDB Site "
|
|
S VERIFY="I $E(DATA,1,14)=""MCCR NDB Site """
|
|
D GETXMZ(SUBJECT,VERIFY)
|
|
;
|
|
; delete the nightly interest/admin/penalty messages
|
|
S SUBJECT="AR Nightly Interest/Admin/Pen"
|
|
S VERIFY="I $E(DATA,1,18)=""BILL DATEPREP"""
|
|
D GETXMZ(SUBJECT,VERIFY)
|
|
Q
|
|
;
|
|
;
|
|
GETXMZ(RCSUBJCT,RCVERIFY) ; find a message to delete
|
|
; loop through a subject, execute a check on the message, kill it
|
|
N DATA,RCSUBJ,RCXMZ
|
|
S RCSUBJ=RCSUBJCT
|
|
F S RCSUBJ=$O(^XMB(3.9,"B",RCSUBJ)) Q:$E(RCSUBJ,1,$L(RCSUBJCT))'=RCSUBJCT D
|
|
. S RCXMZ=0
|
|
. F S RCXMZ=$O(^XMB(3.9,"B",RCSUBJ,RCXMZ)) Q:'RCXMZ D
|
|
. . S DATA=$G(^XMB(3.9,RCXMZ,2,1,0))
|
|
. . X RCVERIFY
|
|
. . ; message found
|
|
. . I $T D
|
|
. . . ; if the current date is not the first, warn the user
|
|
. . . ; if the current date is the first, kill the message
|
|
. . . I $E(DT,6,7)'=$E($$LDATE(DT)+1,6,7) D WARNKILL(RCXMZ) Q
|
|
. . . ;
|
|
. . . ; only kill the message if it was created before the
|
|
. . . ; 15th day of the previous month (since no warning
|
|
. . . ; message would of been generated).
|
|
. . . I $P($$ZNODE^XMXUTIL2(RCXMZ),"^",3)>($E($$FMDIFF^XLFDT(DT,-1),1,5)_19.999999) Q
|
|
. . . ;
|
|
. . . D KILLXMZ(RCXMZ)
|
|
Q
|
|
;
|
|
;
|
|
KILLXMZ(XMZ) ; kills a message and responses
|
|
N K,X,XMABORT,XMKILL,Y
|
|
S XMABORT=0,(XMKILL("MSG"),XMKILL("RESP"))=0
|
|
D KILL^XMA32A(XMZ,.XMKILL,XMABORT)
|
|
Q
|
|
;
|
|
;
|
|
WARNKILL(RCXMZ) ; enter response to the message warning the user the message
|
|
; will deleted on the first of the month
|
|
N %,%H,%I,I,MESSAGE,XMZ2,Y
|
|
;
|
|
; get the first of next month (add 30 days and reset day to 1)
|
|
;S Y=$E($$FMADD^XLFDT(DT,30),1,5)_"01" D DD^%DT
|
|
S Y=$$LDATE(DT)+1 D DD^%DT
|
|
; create response
|
|
S MESSAGE(1)="WARNING, This message will be deleted on "_Y_". Please save"
|
|
S MESSAGE(2)="the data in this message to an excel spreadsheet or word document"
|
|
S MESSAGE(3)="prior to "_Y_"."
|
|
S %=$$ENT^XMA2R(RCXMZ,"Message Deletion",.MESSAGE,"","AR Package")
|
|
Q
|
|
LDATE(X) ; DETERMINE CUT-OFF DATE FOR THE MONTH
|
|
S X=$E(X,1,5)_$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(X,4,5))
|
|
I +$E(X,6,7)=28,$E(X,2,3)#4=0 S $E(X,6,7)=29
|
|
S X=$$WORKPLUS^XUWORKDY(X,-3)
|
|
Q X
|
|
LDAY(X) ;SECOND LAST WORKDAY OF THE MONTH
|
|
S X=$E(X,1,5)_$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(X,4,5))
|
|
I +$E(X,6,7)=28,$E(X,2,3)#4=0 S $E(X,6,7)=29
|
|
S X=$$WORKPLUS^XUWORKDY(X,-1)
|
|
Q X
|