source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRPIQ.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1PRCPRPIQ ;WISC/RFJ-print picking ticket end of report ;07 Feb 92
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7END ; come here to print at bottom of picking ticket
8 N TEXT,X,Y
9 S Y=$P($G(^PRCS(410,+TRANDA,3)),"^",2)
10 S DATA(1)="SPECIAL INSTRUCTIONS/COMMENTS:",TEXT=2
11 F X=1:1 Q:'$D(^PRCS(410,TRANDA,"RM",X,0)) S DATA(TEXT)=^(0),TEXT=TEXT+1
12 F X=1:1 Q:'$D(^PRCS(410,TRANDA,"CO",X,0)) S DATA(TEXT)=^(0),TEXT=TEXT+1
13 F X=1:1 S DATA=$P($T(DATA+X),";",3,99) Q:DATA="" S:DATA["xxxx" DATA=$TR(DATA,"x")_Y S DATA(TEXT)=DATA,TEXT=TEXT+1
14 I $Y>(IOSL-TEXT) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H^PRCPRPIR
15 W !!,"TOTAL DOLLAR AMOUNT OF TRANSACTION: ",$J(TOTAL,0,2)
16 W !!,"INVENTORY AMOUNT OF TRANSACTION (BY ACCOUNT CODE):",! S X="" F %=1:1 S X=$O(ACCT(X)) Q:X="" W ?((%-1)*20),X," : ",$J(ACCT(X),0,2) I %=4 S %=0 W !
17 I $Y>(IOSL-TEXT-1) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H^PRCPRPIR
18 W ! S %=0 F S %=$O(DATA(%)) Q:'% W !,DATA(%)
19 I '$D(PRCPFLAG) D END^PRCPUREP
20 Q
21 ;
22 ;
23DATA ;; print signature at bottom of report
24 ;;FUND CERTIFICATION--- THE SUPPLIES LISTED ON THIS REQUEST ARE PROPERLY
25 ;;CHARGEABLE TO THE FOLLOWING ALLOTMENTS, THE AVAILABLE BALANCES OF WHICH
26 ;;ARE SUFFICIENT TO COVER COST THEREOF, AND FUNDS HAVE BEEN OBLIGATED.
27 ;;
28 ;;APPROPRIATION AND ACCOUNTING SYMBOLS: xxxx
29 ;;
30 ;;OBLIGATED BY:______________________________ DATE:___________________
31 ;;
32 ;;SERVICE SIGNATURE:_________________________ PULLED BY:_______________
33 ;;
34 ;; TITLE:_________________________ VERIFIED BY:_______________
35 ;;
36 ;; DATE RECEIVED:_________________________ DATE TO DELIVER ON:_______________
Note: See TracBrowser for help on using the repository browser.