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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJR 4526 printed Oct 16, 2024@17:48:53 Page 2
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
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
START ; start the nightly process
+1 ; called by PRCABJ
+2 NEW X,Y
+3 ;
+4 ; if the 15th of the month, warn user of deletion
+5 IF $EXTRACT(DT,6,7)=15
DO CLEANXMB
+6 ;
+7 ; clean up old mailman messages on day 1
+8 ; monthly transmission of reports on day 1
+9 IF +$EXTRACT(DT,6,7)=$EXTRACT($$LDATE(DT)+1,6,7)
Begin DoDot:1
+10 ; clean up old mailman messages
+11 DO CLEANXMB
+12 ; NDB and monthly FMS summary documents, bad debt report
+13 ; oig extract (end of quarter)
+14 DO QUEUE("AR Data Collector","DQ^RCRJRCO")
End DoDot:1
+15 ;
+16 ; monthly transmission on the second to last workday
+17 ;
+18 ; Code commented out with patch PRCA*4.5*239
+19 ; Allowances are now transmitted to FMS by the ARDC
+20 ; when it runs on the third to last workday of month.
+21 ;
+22 ; I +$E(DT,6,7)=$E($$LDAY(DT),6,7) D
+23 ; . ; bad debt report sent to FMS
+24 ; . D QUEUE("Bad Debt Report","BADDEBT^RCXFMSSV")
+25 ;
+26 ; quarterly oig transaction report on 15th
+27 IF $EXTRACT(DT,4,5)#3=1
IF $EXTRACT(DT,6,7)=15
DO QUEUE("AR OIG Transaction Extract","EN2^RCNRIG")
+28 ;
+29 ; reports sent on tuesday and thursdays (dmc)
+30 SET X=DT
DO DW^%DTC
+31 IF $EXTRACT(X)="T"
Begin DoDot:1
+32 ; dmc 90 day reports
+33 NEW ZTSAVE
+34 IF '$ORDER(^RC(342,0))
QUIT
+35 ; tUesday
+36 IF $EXTRACT(X,2)="U"
IF $DATA(^RCD(340,"DMC"))
Begin DoDot:2
+37 SET ZTSAVE("RCDOC")="W"
DO QUEUE("DMC 90 Day Reports","ENTER^RCDMC90")
End DoDot:2
QUIT
+38 SET X1=DT
SET X2=7
DO C^%DTC
IF $EXTRACT(DT,4,5)=$EXTRACT(X,4,5)
QUIT
+39 SET ZTSAVE("RCDOC")="M"
DO QUEUE("DMC 90 Day Reports","ENTER^RCDMC90")
End DoDot:1
+40 QUIT
+41 ;
+42 ;
QUEUE(ZTDESC,ZTRTN) ; create taskmanager task
+1 NEW %X,%Y,Y,ZTSK
+2 SET ZTIO=""
SET ZTDTH=$HOROLOG
+3 DO ^%ZTLOAD
+4 DO ^%ZISC
+5 QUIT
+6 ;
+7 ;
CLEANXMB ; clean up old mailman messages generated by AR
+1 NEW SUBJECT,VERIFY
+2 ;
+3 ; delete the AR Data Collector Detail Report
+4 SET SUBJECT="ARDC Detail Report For "
+5 SET VERIFY="I $E(DATA,65)=""."",$E(DATA,76)=""."""
+6 DO GETXMZ(SUBJECT,VERIFY)
+7 ;
+8 ; delete the mccr ndb return reports
+9 SET SUBJECT="MCCR NDB Site "
+10 SET VERIFY="I $E(DATA,1,14)=""MCCR NDB Site """
+11 DO GETXMZ(SUBJECT,VERIFY)
+12 ;
+13 ; delete the nightly interest/admin/penalty messages
+14 SET SUBJECT="AR Nightly Interest/Admin/Pen"
+15 SET VERIFY="I $E(DATA,1,18)=""BILL DATEPREP"""
+16 DO GETXMZ(SUBJECT,VERIFY)
+17 QUIT
+18 ;
+19 ;
GETXMZ(RCSUBJCT,RCVERIFY) ; find a message to delete
+1 ; loop through a subject, execute a check on the message, kill it
+2 NEW DATA,RCSUBJ,RCXMZ
+3 SET RCSUBJ=RCSUBJCT
+4 FOR
SET RCSUBJ=$ORDER(^XMB(3.9,"B",RCSUBJ))
if $EXTRACT(RCSUBJ,1,$LENGTH(RCSUBJCT))'=RCSUBJCT
QUIT
Begin DoDot:1
+5 SET RCXMZ=0
+6 FOR
SET RCXMZ=$ORDER(^XMB(3.9,"B",RCSUBJ,RCXMZ))
if 'RCXMZ
QUIT
Begin DoDot:2
+7 SET DATA=$GET(^XMB(3.9,RCXMZ,2,1,0))
+8 XECUTE RCVERIFY
+9 ; message found
+10 IF $TEST
Begin DoDot:3
+11 ; if the current date is not the first, warn the user
+12 ; if the current date is the first, kill the message
+13 IF $EXTRACT(DT,6,7)'=$EXTRACT($$LDATE(DT)+1,6,7)
DO WARNKILL(RCXMZ)
QUIT
+14 ;
+15 ; only kill the message if it was created before the
+16 ; 15th day of the previous month (since no warning
+17 ; message would of been generated).
+18 IF $PIECE($$ZNODE^XMXUTIL2(RCXMZ),"^",3)>($EXTRACT($$FMDIFF^XLFDT(DT,-1),1,5)_19.999999)
QUIT
+19 ;
+20 DO KILLXMZ(RCXMZ)
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
+23 ;
KILLXMZ(XMZ) ; kills a message and responses
+1 NEW K,X,XMABORT,XMKILL,Y
+2 SET XMABORT=0
SET (XMKILL("MSG"),XMKILL("RESP"))=0
+3 DO KILL^XMA32A(XMZ,.XMKILL,XMABORT)
+4 QUIT
+5 ;
+6 ;
WARNKILL(RCXMZ) ; enter response to the message warning the user the message
+1 ; will deleted on the first of the month
+2 NEW %,%H,%I,I,MESSAGE,XMZ2,Y
+3 ;
+4 ; get the first of next month (add 30 days and reset day to 1)
+5 ;S Y=$E($$FMADD^XLFDT(DT,30),1,5)_"01" D DD^%DT
+6 SET Y=$$LDATE(DT)+1
DO DD^%DT
+7 ; create response
+8 SET MESSAGE(1)="WARNING, This message will be deleted on "_Y_". Please save"
+9 SET MESSAGE(2)="the data in this message to an excel spreadsheet or word document"
+10 SET MESSAGE(3)="prior to "_Y_"."
+11 SET %=$$ENT^XMA2R(RCXMZ,"Message Deletion",.MESSAGE,"","AR Package")
+12 QUIT
LDATE(X) ; DETERMINE CUT-OFF DATE FOR THE MONTH
+1 SET X=$EXTRACT(X,1,5)_$PIECE("31^28^31^30^31^30^31^31^30^31^30^31","^",+$EXTRACT(X,4,5))
+2 IF +$EXTRACT(X,6,7)=28
IF $EXTRACT(X,2,3)#4=0
SET $EXTRACT(X,6,7)=29
+3 SET X=$$WORKPLUS^XUWORKDY(X,-3)
+4 QUIT X
LDAY(X) ;SECOND LAST WORKDAY OF THE MONTH
+1 SET X=$EXTRACT(X,1,5)_$PIECE("31^28^31^30^31^30^31^31^30^31^30^31","^",+$EXTRACT(X,4,5))
+2 IF +$EXTRACT(X,6,7)=28
IF $EXTRACT(X,2,3)#4=0
SET $EXTRACT(X,6,7)=29
+3 SET X=$$WORKPLUS^XUWORKDY(X,-1)
+4 QUIT X
