| 1 | RCRJR ;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 | ;
|
|---|
| 7 | START ; 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 | ;
|
|---|
| 50 | QUEUE(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 | ;
|
|---|
| 58 | CLEANXMB ; 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 | ;
|
|---|
| 78 | GETXMZ(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 | ;
|
|---|
| 102 | KILLXMZ(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 | ;
|
|---|
| 109 | WARNKILL(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
|
|---|
| 122 | LDATE(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
|
|---|
| 127 | LDAY(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
|
|---|
