source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAKM.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PRCAKM ;WASH-ISC@ALTOONA,PA/CMS-AR Mark as PENDING ARCHIVE ;10/20/94 2:20 PM
2V ;;4.5;Accounts Receivable;**104**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 NEW BEG,FDT,ND,PAGE,X,X1,X2,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,%DT
5 W !!,"This option will change the status of the AR Records whose Date of",!,"Last Activity is within the time frame selected to Pending Archive.",!
6 S X1=DT,X2=-3*365 D C^%DTC S (FDT,Y)=$E(X,1)_$$FY^RCFN01(X)_1001
7 ;S (FDT,Y)=$E(DT,1)_($$FY^RCFN01(X))_1001
8 W !!,"NOTE: The Archive Ending Date must be before " D DD^%DT W Y,!
9 I $P(^PRCA(430.3,+$O(^PRCA(430.3,"AC",114,0)),0),U)'="PENDING ARCHIVE" W !!,"The PENDING ARCHIVE entry is not setup properly in File 430.3" G Q
10BEG W !!,"IF you want to archive all valid records through the ending date,",!,"press return to take the default of NONE.",!
11 D NOW^%DTC S %DT(0)=-%,%DT="AEXP",%DT("A")="Archive Starting from Date: NONE//" D ^%DT S:X="" Y=2010101 G:Y<0 Q S BEG=Y
12 S %DT="AEXP",%DT("A")="Archive Ending through Date: " D ^%DT G:Y<0 Q S END=Y
13 I BEG>END W !!,*7,"*** Beginning date is greater than Ending date ***",! G BEG
14 I END'<FDT W !!,*7,"*** Ending date is after cut-off date ***",! G BEG
15 S X2=BEG,X1=END D ^%DTC I X>365 W !!,*7,"WARNING: The date range is greater than one year.",!,"This may cause a large amount of system activity during the Archive processes!",!
16 W !!,"Are you sure" S %=2 D YN^DICN I %'=1 Q
17 S ZTRTN="DQ^PRCAKM",ZTSAVE("BEG")="",ZTSAVE("END")="",ZTDESC="Mark AR Records for Archive",ZTIO="" D ^%ZTLOAD
18Q Q
19DQ ;
20 NEW CNT,DATE,PRCA,PRCABN,STAT
21 L +^PRCAK("PRCAK"):1 I '$T D BUSY^PRCAKS("Mark AR records for PENDING ARCHIVE") G END
22 S CNT=0,PRCA("STATUS")=$O(^PRCA(430.3,"AC",114,0)),PRCA("SDT")=DT
23 F PRCABN=0:0 S PRCABN=$O(^PRCA(430,PRCABN)) Q:'PRCABN D
24 .I $P($G(^PRCA(430,PRCABN,0)),U,8)=PRCA("STATUS") S CNT=CNT+1 Q
25 .Q:$P($G(^PRCA(430,PRCABN,0)),U,8)=49
26 .S DATE=$$PUR^PRCAFN(PRCABN) I DATE&(DATE'>END)&(DATE'<BEG)!(DATE=-2) D UPSTATS^PRCAUT2 S CNT=CNT+1
27 D BULL
28 L -^PRCAK("PRCAK")
29END Q
30BULL ;Send total in bulletin
31 N XMDUZ,XMSUB,XMTEXT,XMY
32 S XMDUZ="AR ARCHIVE PACKAGE",XMSUB="AR PENDING ARCHIVE TOTAL",XMY(+DUZ)="",XMTEXT="X1("
33 S X1(1)="The total number of bills marked as Pending Archive is "_CNT,X1(2)=" "
34 S X1(3)="Date Range selected: "_$S(BEG=2010101:"Beginning",1:$$SLH^RCFN01(BEG))_" thru "_$$SLH^RCFN01(END)
35 S X1(4)=" "
36 S X1(5)="Please forward this total to the IRM System Manager."
37 S X1(6)="This total will help IRM determine the amount of system activity",X1(7)="that will occur during the AR Archival processes."
38 S X1(8)=" ",X1(9)="NOTE: This total includes the number of bills, only!"
39 S X1(10)=" The number of archived records created will include the"
40 S X1(11)=" number of bills and all corresponding transactions."
41XM D ^XMD
42 Q
Note: See TracBrowser for help on using the repository browser.