43 lines
2.7 KiB
Mathematica
43 lines
2.7 KiB
Mathematica
PRCAKM ;WASH-ISC@ALTOONA,PA/CMS-AR Mark as PENDING ARCHIVE ;10/20/94 2:20 PM
|
|
V ;;4.5;Accounts Receivable;**104**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
NEW BEG,FDT,ND,PAGE,X,X1,X2,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,%DT
|
|
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.",!
|
|
S X1=DT,X2=-3*365 D C^%DTC S (FDT,Y)=$E(X,1)_$$FY^RCFN01(X)_1001
|
|
;S (FDT,Y)=$E(DT,1)_($$FY^RCFN01(X))_1001
|
|
W !!,"NOTE: The Archive Ending Date must be before " D DD^%DT W Y,!
|
|
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
|
|
BEG W !!,"IF you want to archive all valid records through the ending date,",!,"press return to take the default of NONE.",!
|
|
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
|
|
S %DT="AEXP",%DT("A")="Archive Ending through Date: " D ^%DT G:Y<0 Q S END=Y
|
|
I BEG>END W !!,*7,"*** Beginning date is greater than Ending date ***",! G BEG
|
|
I END'<FDT W !!,*7,"*** Ending date is after cut-off date ***",! G BEG
|
|
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!",!
|
|
W !!,"Are you sure" S %=2 D YN^DICN I %'=1 Q
|
|
S ZTRTN="DQ^PRCAKM",ZTSAVE("BEG")="",ZTSAVE("END")="",ZTDESC="Mark AR Records for Archive",ZTIO="" D ^%ZTLOAD
|
|
Q Q
|
|
DQ ;
|
|
NEW CNT,DATE,PRCA,PRCABN,STAT
|
|
L +^PRCAK("PRCAK"):1 I '$T D BUSY^PRCAKS("Mark AR records for PENDING ARCHIVE") G END
|
|
S CNT=0,PRCA("STATUS")=$O(^PRCA(430.3,"AC",114,0)),PRCA("SDT")=DT
|
|
F PRCABN=0:0 S PRCABN=$O(^PRCA(430,PRCABN)) Q:'PRCABN D
|
|
.I $P($G(^PRCA(430,PRCABN,0)),U,8)=PRCA("STATUS") S CNT=CNT+1 Q
|
|
.Q:$P($G(^PRCA(430,PRCABN,0)),U,8)=49
|
|
.S DATE=$$PUR^PRCAFN(PRCABN) I DATE&(DATE'>END)&(DATE'<BEG)!(DATE=-2) D UPSTATS^PRCAUT2 S CNT=CNT+1
|
|
D BULL
|
|
L -^PRCAK("PRCAK")
|
|
END Q
|
|
BULL ;Send total in bulletin
|
|
N XMDUZ,XMSUB,XMTEXT,XMY
|
|
S XMDUZ="AR ARCHIVE PACKAGE",XMSUB="AR PENDING ARCHIVE TOTAL",XMY(+DUZ)="",XMTEXT="X1("
|
|
S X1(1)="The total number of bills marked as Pending Archive is "_CNT,X1(2)=" "
|
|
S X1(3)="Date Range selected: "_$S(BEG=2010101:"Beginning",1:$$SLH^RCFN01(BEG))_" thru "_$$SLH^RCFN01(END)
|
|
S X1(4)=" "
|
|
S X1(5)="Please forward this total to the IRM System Manager."
|
|
S X1(6)="This total will help IRM determine the amount of system activity",X1(7)="that will occur during the AR Archival processes."
|
|
S X1(8)=" ",X1(9)="NOTE: This total includes the number of bills, only!"
|
|
S X1(10)=" The number of archived records created will include the"
|
|
S X1(11)=" number of bills and all corresponding transactions."
|
|
XM D ^XMD
|
|
Q
|