- 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 Feb 18, 2025@23:14:26 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