| 1 | PRCAKUN ;WASH-ISC@ALTOONA,PA/CMS-Unmark Pending Archive ;8/24/93 8:09 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**68**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN1 ;Unmark records marked for archival entry point
|
|---|
| 5 | N %,DIC,DIR,DTOUT,DUOUT,PRCA,PRCABN,PRCATY,Y
|
|---|
| 6 | I $P($G(^PRCAK(430.8,0)),U,3)>0 W !!,"The PENDING ARCHIVE records were moved to temporary storage!",!,"You cannot unmark these records." G EN1Q
|
|---|
| 7 | S DIR("A")="Do you want to unmark ALL bills PENDING ARCHIVE",DIR("B")="NO",DIR(0)="Y",DIR("?")="Enter 'Y' to unmark all bills in this status for the same remarks" D ^DIR
|
|---|
| 8 | I $D(DTOUT)!$D(DUOUT) G EN1Q
|
|---|
| 9 | I Y=1 G ALL
|
|---|
| 10 | W ! S DIC("S")="I $P(^PRCA(430,+Y,0),U,8)=$O(^PRCA(430.3,""B"",""PENDING ARCHIVE"",0))",DIC(0)="AEQMZ",DIC="^PRCA(430," D ^DIC S PRCABN=+Y G:$G(PRCABN)'>0 EN1Q
|
|---|
| 11 | I '$P(^PRCA(430,PRCABN,9),U,6) W !!,"This bill does not have a previous status!" G EN1Q
|
|---|
| 12 | EN1A W !,"Change the status of this bill back to ",$P($G(^PRCA(430.3,+$P(^PRCA(430,PRCABN,9),U,6),0)),U,1) S %=2 D YN^DICN D:%=1 EN1S
|
|---|
| 13 | I %=0 W !!,"Enter YES if you want to change the status of the bill back to the",!,"previous status to prevent the bill from being archived!",! G EN1A
|
|---|
| 14 | EN1Q Q
|
|---|
| 15 | EN1S ;prompt user for change status data.
|
|---|
| 16 | N DA,DIE,DR,X
|
|---|
| 17 | S DR="8////^S X="_$S($P($G(^PRCA(430,PRCABN,9)),U,6):$P(^(9),U,6),1:15)_";15;17////^S X="_$G(DUZ),DIE="^PRCA(430,",DA=PRCABN D ^DIE
|
|---|
| 18 | Q
|
|---|
| 19 | ALL ;Loop on PENDING ARCHIVE status and reverse all bills
|
|---|
| 20 | N REM
|
|---|
| 21 | L +^PRCAK("PRCAK"):1 I '$T W *7,!!,"WARNING: Another AR Archive Process is still running!",!!
|
|---|
| 22 | L -^PRCAK("PRCAK")
|
|---|
| 23 | W !!,"Enter a Status Remark (3-45 characters) for all bills unmarked for archival."
|
|---|
| 24 | REM R !,"Status Remark: ",REM:DTIME I '$T!(REM["^") G EN1Q
|
|---|
| 25 | I $G(REM)]"",($L(REM)<3!($L(REM)>45)) W !,"Remark must be 3-45 characters in length" G REM
|
|---|
| 26 | I $O(^PRCA(430.3,"AC",114,0))="" W !!,*7,"Please contact your IRM. The Pending Archive status is not setup properly!",! Q
|
|---|
| 27 | I '$O(^PRCA(430,"AC",$O(^PRCA(430.3,"AC",114,0)),0)) W !!,*7,"Cannot find any bills in the Pending Archive status!",! Q
|
|---|
| 28 | S ZTRTN="DQ^PRCAKUN",ZTIO="",ZTSAVE("REM")="" D ^%ZTLOAD
|
|---|
| 29 | Q
|
|---|
| 30 | DQ ;
|
|---|
| 31 | NEW ST,PRCABN,X,DA,DIE,DR
|
|---|
| 32 | L +^PRCAK("PRCAK"):1 I '$T D BUSY^PRCAKS("Unmark ALL Pending Archive Records") G END
|
|---|
| 33 | S ST=$O(^PRCA(430.3,"AC",114,0)) I ST="" G END
|
|---|
| 34 | S PRCABN="" F S PRCABN=$O(^PRCA(430,"AC",ST,PRCABN)) Q:'PRCABN D
|
|---|
| 35 | .I '$D(^PRCA(430,PRCABN,0)) K ^PRCA(430,"AC",ST,PRCABN) Q
|
|---|
| 36 | .S DR="8////^S X="_$S($P($G(^PRCA(430,PRCABN,9)),U,6):$P(^(9),U,6),1:15)_";15////^S X=$G(REM);17////^S X=DUZ",DIE="^PRCA(430,",DA=PRCABN D ^DIE
|
|---|
| 37 | .Q
|
|---|
| 38 | END L -^PRCAK("PRCAK") Q
|
|---|
