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