Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCRJR

RCRJR.m

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