| 1 | PRCAKMR ;WASH-ISC@ALTOONA,PA/CMS-Print Status PENDING ARCHIVE ;8/3/93 12:09 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**78**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;Loop on Pending Archive status, entry point after device selection
|
|---|
| 5 | NEW PG,PRCAE,PRCAT,STAT,TR,X,Y
|
|---|
| 6 | D HDR
|
|---|
| 7 | S STAT=+$O(^PRCA(430.3,"B","PENDING ARCHIVE",0))
|
|---|
| 8 | I $P($G(^PRCA(430.3,STAT,0)),"^",1)'="PENDING ARCHIVE" W !!,?5,"* The Pending Archive status is not defined. Please contact IRM!",! G Q1
|
|---|
| 9 | F PRCAE=0:0 S PRCAE=$O(^PRCA(430,"AC",STAT,PRCAE)) Q:'PRCAE S X="" D HDR:$Y+5>IOSL Q:X="^" D PRNTL
|
|---|
| 10 | I $G(X)'="^" W !!!,?5,+$G(PRCAT)," Bills marked Pending Archive"
|
|---|
| 11 | G Q1
|
|---|
| 12 | PRNTL ;
|
|---|
| 13 | ;Print detail data line on report
|
|---|
| 14 | S PRCAT=$G(PRCAT)+1
|
|---|
| 15 | S X=$S($D(^PRCA(430,PRCAE,0)):^(0),1:"") G:X="" PQ W !,$E($P(X,U,1),1,11)
|
|---|
| 16 | W ?13,$S($P(X,U,9):$E($P($$NAM^RCFN01($P(X,U,9)),U),1,21),1:"UNKNOWN")
|
|---|
| 17 | W ?36,$S($P(X,U,2):$P($G(^PRCA(430.2,$P(X,U,2),0)),U,2),1:"")
|
|---|
| 18 | W ?42,$E($P($G(^PRCA(430.3,+$P($G(^PRCA(430,PRCAE,9)),U,6),0)),U,1),1,10)
|
|---|
| 19 | W ?54 S Y=$G(^PRCA(430,PRCAE,7)),Y=$P(Y,"^",1)+$P(Y,"^",2)+$P(Y,"^",3)+$P(Y,"^",4)+$P(Y,"^",5) W $J(Y,0,2)
|
|---|
| 20 | W ?67 S Y=$$PUR^PRCAFN(PRCAE) I Y>0 S Y=$P(Y,".",1) X ^DD("DD") W Y
|
|---|
| 21 | PQ Q
|
|---|
| 22 | HDR ;
|
|---|
| 23 | ;Print header on top of page
|
|---|
| 24 | I $E(IOST,1,2)="C-",$G(PG) S X="" R !,"Enter '^' to exit, press any key to continue: ",X:DTIME S:'$T X="^" Q:X="^"
|
|---|
| 25 | W @IOF S PG=$G(PG)+1
|
|---|
| 26 | N %,%H,%I,X,Y
|
|---|
| 27 | D NOW^%DTC S Y=% D DD^%DT
|
|---|
| 28 | W !,"Status: PENDING ARCHIVE",?46,Y,?70,"PAGE ",PG
|
|---|
| 29 | W !!,?42,"Old Bill",?67,"Last Date",!,"Bill No.",?13,"Debtor",?36,"Cat.",?42,"Status",?54,"Balance",?67,"Activity"
|
|---|
| 30 | W ! S X="",$P(X,"-",IOM-1)="" W X,!
|
|---|
| 31 | Q
|
|---|
| 32 | ST ;
|
|---|
| 33 | NEW ZTSK,STAT
|
|---|
| 34 | W !!,"This report will print the AR bills in the PENDING ARCHIVE status.",!
|
|---|
| 35 | L +^PRCAK("PRCAK"):1 I '$T W !!,"Another Archive process is running. This report may not be",!,"accurate. You may want to re-run at a later time.",!
|
|---|
| 36 | L -^PRCAK("PRCAK")
|
|---|
| 37 | S %ZIS="MQ" D ^%ZIS G:POP Q1
|
|---|
| 38 | I '$D(IO("Q")) U IO D PRCAKMR Q
|
|---|
| 39 | S ZTRTN="^PRCAKMR",ZTDESC="AR PENDING ARCHIVE Listing" D ^%ZTLOAD
|
|---|
| 40 | Q1 D ^%ZISC K POP
|
|---|
| 41 | Q
|
|---|
