source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAKMR.m@ 1094

Last change on this file since 1094 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1PRCAKMR ;WASH-ISC@ALTOONA,PA/CMS-Print Status PENDING ARCHIVE ;8/3/93 12:09 PM
2V ;;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
12PRNTL ;
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
21PQ Q
22HDR ;
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
32ST ;
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
40Q1 D ^%ZISC K POP
41 Q
Note: See TracBrowser for help on using the repository browser.