| 1 | PRCAKM ;WASH-ISC@ALTOONA,PA/CMS-AR Mark as PENDING ARCHIVE ;10/20/94 2:20 PM
|
|---|
| 2 | V ;;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
|
|---|
| 10 | BEG 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
|
|---|
| 18 | Q Q
|
|---|
| 19 | DQ ;
|
|---|
| 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")
|
|---|
| 29 | END Q
|
|---|
| 30 | BULL ;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."
|
|---|
| 41 | XM D ^XMD
|
|---|
| 42 | Q
|
|---|
