[613] | 1 | PRCAKBT ;WASH-ISC@ALTOONA,PA/CMS-AR BUILD TEMP ARCHIVE FILE ;9/10/93 8:39 AM ;9/10/93 8:26 AM
|
---|
| 2 | V ;;4.5;Accounts Receivable;;Mar 20, 1995
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,%
|
---|
| 5 | I $P($G(^PRCAK(430.8,0)),U,3)>0 W !!,*7,"The temporary storage file already has data!" G Q
|
---|
| 6 | W !!,"This option will build the temporary storage file (AR Archive File 430.8)",!,"with all the data and corresponding transactions from the bills in the",!,"Pending Archive status."
|
---|
| 7 | W !!,"The use of this option should be coordinated with the IRM System Manager to",!,"determine disk and journal space!"
|
---|
| 8 | S STAT=$O(^PRCA(430.3,"AC",114,0)) I $P(^PRCA(430.3,+$G(STAT),0),U)'="PENDING ARCHIVE" W !!,*7,"The PENDING ARCHIVE File 430.3 entry is not setup properly, contact IRM." G Q
|
---|
| 9 | W !!,"ARE YOU SURE YOUR SYSTEM IS READY " S %=2 D YN^DICN I %'=1 G Q
|
---|
| 10 | W !,"I'll send you a mail message when I am done.",!
|
---|
| 11 | S ZTRTN="DQ^PRCAKBT",ZTDESC="Build AR Archive File",ZTIO="" D ^%ZTLOAD
|
---|
| 12 | Q Q
|
---|
| 13 | DQ ;
|
---|
| 14 | NEW CNT,DA,DIC,DIQ,DR,FIL,II,STAT
|
---|
| 15 | L +^PRCAK("PRCAK"):1 I '$T D BUSY^PRCAKS("Build Temporary Storage") G END
|
---|
| 16 | S STAT=$O(^PRCA(430.3,"AC",114,0))
|
---|
| 17 | K ^TMP("PRCAK",$J),^UTILITY("DIQ1",$J) S ^TMP("PRCAK",$J,"E")=9
|
---|
| 18 | S DR=.01,DIQ(0)="N"
|
---|
| 19 | F FIL="430","430.01","430.02","430.051","430.098","433","433.01","433.041","433.061" S DIC="^DD("_FIL_"," D
|
---|
| 20 | .F DA=0:0 S DA=$O(^DD(FIL,DA)) Q:'DA D EN^DIQ1 D
|
---|
| 21 | ..I '$D(^UTILITY("DIQ1",$J)) S ^TMP("PRCAK",$J,"E","D430")="Could not build File "_FIL_" Field Records" Q
|
---|
| 22 | ..F II=0:0 S II=$O(^UTILITY("DIQ1",$J,0,II)) Q:'II S ^TMP("PRCAK",$J,"F",FIL,II)=^(II,.01) K ^UTILITY("DIQ1",$J,0,II)
|
---|
| 23 | I ^TMP("PRCAK",$J,"E")>9 D BULL G END
|
---|
| 24 | D ^PRCAKBT1
|
---|
| 25 | D BULL
|
---|
| 26 | L -^PRCAK("PRCAK")
|
---|
| 27 | END Q
|
---|
| 28 | BULL ;Send total in bulletin
|
---|
| 29 | N XMDUZ,XMSUB,XMTEXT,XMY,X1
|
---|
| 30 | S XMDUZ="AR ARCHIVE PACKAGE",XMSUB="BUILD TEMP ARCHIVE FILE",XMY(+DUZ)="",XMTEXT="^TMP(""PRCAK"",$J,""E"","
|
---|
| 31 | I ^TMP("PRCAK",$J,"E")>9 G R0
|
---|
| 32 | S ^TMP("PRCAK",$J,"E",1)=" The AR Build Temporary Archive process successfully completed.",^TMP("PRCAK",$J,"E",2)=" A total of "_+$G(CNT)_" archive records were created."
|
---|
| 33 | S ^TMP("PRCAK",$J,"E",3)=" ",^TMP("PRCAK",$J,"E",4)="You/IRM may move the archived records to permanent storage.",^TMP("PRCAK",$J,"E",5)=" ",^TMP("PRCAK",$J,"E",6)="Have a Nice Day!" G XM
|
---|
| 34 | R0 ;All Bills not successfully moved
|
---|
| 35 | S ^TMP("PRCAK",$J,"E",1)=" The AR Build Temporary Archive process DID NOT successfully move all",^TMP("PRCAK",$J,"E",2)=" the AR Bills in the Pending Archive status to the temporary storage file."
|
---|
| 36 | S ^TMP("PRCAK",$J,"E",3)=" A total of "_+$G(CNT)_" archive records were created.",^TMP("PRCAK",$J,"E",4)=" "
|
---|
| 37 | S ^TMP("PRCAK",$J,"E",5)=" Below is the list of bills and explanations.",^TMP("PRCAK",$J,"E",6)=" Refer to the A/R Technical Manual for steps to correct these entries."
|
---|
| 38 | S ^TMP("PRCAK",$J,"E",7)=" After corrective action has been taken, 'Unmark' these entries."
|
---|
| 39 | S ^TMP("PRCAK",$J,"E",8)=" The entries will be archived when the next time the archive process is run.",^TMP("PRCAK",$J,"E",9)=" "
|
---|
| 40 | XM D ^XMD K ^TMP("PRCAK",$J),^UTILITY("DIQ1",$J)
|
---|
| 41 | Q
|
---|