| [613] | 1 | PRCAKS ;WASH-ISC@ALTOONA,PA/CMS-AR Remove Records-Mark as ARCHIVED ;6/4/93 11:05 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**67**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | NEW BEG,DATE,FDT,ND,PAGE,X,X1,X2,Y,ZTDESC,ZTRTN,ZTSAVE,%DT
|
|---|
| 5 | W !!,"This option will change the status of the AR Bills in the",!,"Pending Archive status that were moved to temporary storage"
|
|---|
| 6 | W !,"to the ARCHIVED status. The bill data and corresponding",!,"transactions will be deleted."
|
|---|
| 7 | W !!,"The entries in the archival temporary storage file will be deleted."
|
|---|
| 8 | I $P(^PRCA(430.3,+$O(^PRCA(430.3,"AC",115,0)),0),U)'="ARCHIVED" W !!,"The ARCHIVED entry is not setup properly in File 430.3" G Q
|
|---|
| 9 | W !!,"Enter the Archive Date that is marked on the AR Archive Permanent Storage Label."
|
|---|
| 10 | W !,"This date will display when inquires are made to ARCHIVED bills.",!
|
|---|
| 11 | D NOW^%DTC S %DT="AEXP",%DT(0)=-%,%DT("A")="Enter the Archive Date: " D ^%DT G:+Y<1 Q S DATE=+Y
|
|---|
| 12 | W !!,"NOTE: You should have verified that the data in the temporary",!,"storage file is in a permanent storage place before you continue!"
|
|---|
| 13 | W !!,"Are you sure you want to Archive AR data records" S %=2 D YN^DICN I %'=1 Q
|
|---|
| 14 | W !,"Okay, I'll send you a mail message when I'm done.",!
|
|---|
| 15 | S ZTRTN="DQ^PRCAKS",ZTSAVE("DATE")="",ZTDESC="Archive AR Records",ZTIO="" D ^%ZTLOAD
|
|---|
| 16 | Q Q
|
|---|
| 17 | DQ ;
|
|---|
| 18 | NEW ARN,BN0,OSTAT,PRCABN,STAT
|
|---|
| 19 | L +^PRCAK("PRCAK"):1 I '$T D BUSY^PRCAKS("Remove AR Records") G END
|
|---|
| 20 | S OSTAT=$O(^PRCA(430.3,"AC",114,0))
|
|---|
| 21 | S STAT=$O(^PRCA(430.3,"AC",115,0))
|
|---|
| 22 | F ARN=0:0 S ARN=$O(^PRCAK(430.8,ARN)) Q:'ARN S BN0=$G(^PRCAK(430.8,ARN,0)) I BN0'="" S PRCABN=$O(^PRCA(430,"B",$P(BN0,"-",1,2),0)) I PRCABN D PUR
|
|---|
| 23 | D PUR^PRCAKTP
|
|---|
| 24 | D BULL
|
|---|
| 25 | L -^PRCAK("PRCAK")
|
|---|
| 26 | END Q
|
|---|
| 27 | PUR ;purge data records
|
|---|
| 28 | N DA,DIK,LN,TN
|
|---|
| 29 | I $P(^PRCA(430,PRCABN,0),U,8)'=OSTAT Q
|
|---|
| 30 | S DIK="^PRCA(433," F TN=0:0 S TN=$O(^PRCA(433,"C",PRCABN,TN)) Q:'TN D
|
|---|
| 31 | .I $G(^PRCA(433,TN,0))']"" K ^PRCA(430,"C",PRCABN,TN) Q
|
|---|
| 32 | .S PRCAEN=TN,PRCAARC=1,PRCANOPR=1 D DELETE^PRCAWO1
|
|---|
| 33 | S LN=^PRCA(430,PRCABN,0)
|
|---|
| 34 | S DIK="^PRCA(430,",DA=PRCABN D ^DIK
|
|---|
| 35 | S ^PRCA(430,PRCABN,0)=$P(LN,U,1),$P(^(0),U,8)=STAT,$P(^(0),U,10)=DATE
|
|---|
| 36 | S DA=PRCABN D IX1^DIK
|
|---|
| 37 | S $P(^PRCA(430,0),U,4)=$P(^PRCA(430,0),U,4)+1
|
|---|
| 38 | K PRCAARC,PRCAEN,PRCANOPR
|
|---|
| 39 | Q
|
|---|
| 40 | BULL ;Send total in bulletin
|
|---|
| 41 | N XMDUZ,XMSUB,XMTEXT,XMY
|
|---|
| 42 | S XMDUZ="AR ARCHIVE PACKAGE",XMSUB="AR ARCHIVE COMPLETION",XMY(+DUZ)="",XMTEXT="X1("
|
|---|
| 43 | S X1(1)=" The AR Archival of AR record data in the Accounts Receivable"
|
|---|
| 44 | S X1(2)=" File 430 and the corresponding AR Transactions in File 433"
|
|---|
| 45 | S X1(2)=" is complete. The records in the temporary storage file"
|
|---|
| 46 | S X1(3)=" (AR Archive 430.8) were purged."
|
|---|
| 47 | XM D ^XMD
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | BUSY(ARH) ;
|
|---|
| 51 | NEW XMDUZ,XMSUB,XMTEXT,XMY,X1
|
|---|
| 52 | S XMDUZ="AR ARCHIVE PACKAGE",XMSUB="Failure to Run (Busy)",XMY(+DUZ)="",XMTEXT="X1("
|
|---|
| 53 | S X1(1)="You attempted to run the archive process: "_ARH
|
|---|
| 54 | S X1(2)="This processes failed because another AR archive process",X1(3)="was already in progress."
|
|---|
| 55 | D ^XMD
|
|---|
| 56 | Q
|
|---|
