source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRSS0.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1PRCPRSS0 ;WISC/RFJ/DL/DAP-stock status report print for warehouse;1/28/98
2V ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6 ;
7PRINT ; print report
8 N DAYS,MONTH,NOW,PAGE,PRCPFLAG,SCREEN,TOTCLOS,TOTISS,TOTN,TOTOPEN,TOTVAL
9 S Y=DATESTRT D DD^%DT S MONTH=Y
10 S DAYS=$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(DATESTRT,4,5))
11 I DAYS=28 S %=(17+$E(DATESTRT))_$E(DATESTRT,2,3),DAYS=$S(%#400=0:29,(%#4=0&(%#100'=0)):29,1:28)
12 S SCREEN=$$SCRPAUSE^PRCPUREP,PAGE=1 D NOW^%DTC S Y=% D DD^%DT S NOW=Y U IO D H
13 W !!,"OPEN BALANCE",?14 S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(OPEN(ACCT)),"^",2),OPEN(ACCT)=%,TOTOPEN=TOTOPEN+% W $$SHOWVALU(%)
14 W $$SHOWVALU(TOTOPEN)
15 W !!,"RECEIPTS",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(REC(ACCT)),TOTAL=TOTAL+%,OPEN(ACCT)=$G(OPEN(ACCT))+% W $$SHOWVALU(%)
16 W $$SHOWVALU(TOTAL)
17 ;
18 ;*98 Changed previous displays of "issues" to "usage"
19 ;
20 W !,"USAGE",?14 S TOTISS=0 F ACCT=1,2,3,6,8 S %=$G(ISS(ACCT)),TOTISS=TOTISS+%,OPEN(ACCT)=$G(OPEN(ACCT))+% W $$SHOWVALU(%)
21 W $$SHOWVALU(TOTISS)
22 W !,"ADJUSTMENTS",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(ADJ(ACCT)),TOTAL=TOTAL+%,OPEN(ACCT)=$G(OPEN(ACCT))+% W $$SHOWVALU(%)
23 W $$SHOWVALU(TOTAL)
24 S %="",$P(%,"=",80)=""
25 W !,%,!,"CLOSE BALANCE",?14 S TOTCLOS=0 F ACCT=1,2,3,6,8 S %=$G(OPEN(ACCT)),TOTCLOS=TOTCLOS+% W $$SHOWVALU(%)
26 W $$SHOWVALU(TOTCLOS)
27 W !!!,"# RECEIPTS",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(RECN(ACCT)),TOTAL=TOTAL+%,TOTN(ACCT)=% W $J(%,11,0)
28 W $J(TOTAL,11,0)
29 ;
30 ;*98 Changed previous displays of "issues" to "usage"
31 ;
32 W !,"# USAGE",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(ISSN(ACCT)),TOTAL=TOTAL+%,TOTN(ACCT)=$G(TOTN(ACCT))+% W $J(%,11,0)
33 W $J(TOTAL,11,0)
34 W !,"# ADJUSTMENTS",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(ADJN(ACCT)),TOTAL=TOTAL+%,TOTN(ACCT)=$G(TOTN(ACCT))+% W $J(%,11,0)
35 W $J(TOTAL,11,0)
36 S %="",$P(%,"=",80)=""
37 W !,%,!,"# TOTAL",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(TOTN(ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
38 W $J(TOTAL,11,0)
39 W !!,"TURNOVER",?13 F ACCT=1,2,3,6,8 S %=($G(ISS(ACCT))*365)/DAYS,%=$S('$G(OPEN(ACCT)):"X",1:-%/OPEN(ACCT)) W $J(%,11,2)
40 S %=(TOTISS*365)/DAYS,%=$S('TOTCLOS:"X",1:-%/TOTCLOS) W $J(%,11,2)
41 I $Y>(IOSL-10) W ! D:SCREEN P^PRCPUREP G:$G(PRCPFLAG) Q D H
42 W !!?28,"*** CURRENT DATA ***",!,"$ ONHAND VALUE",?14 S TOTVAL=0 F ACCT=1,2,3,6,8 S %=$G(VALUE(ACCT)),TOTVAL=TOTVAL+% W $$SHOWVALU(%)
43 W $$SHOWVALU(TOTVAL)
44 W !,"$ DUEINS",?14 S X=0 F ACCT=1,2,3,6,8 S %=$G(DUEIN(ACCT)),X=X+% W $$SHOWVALU(%)
45 W $$SHOWVALU(X)
46 W !,"$ DUEOUTS",?14 S X=0 F ACCT=1,2,3,6,8 S %=$G(DUEOUT(ACCT)),X=X+% W $$SHOWVALU(%)
47 W $$SHOWVALU(X)
48 S Y=$E(DATEINAC,1,5)_"01" D DD^%DT
49 W !!?2,"INACTIVE ITEMS FROM ",Y," TO ",$P(NOW,"@"),!,"# INACTIVE",?13
50 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(INACTN(ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
51 W $J(TOTAL,11,0)
52 W !,"$ INACTIVE",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(INACT(ACCT)),TOTAL=TOTAL+% W $$SHOWVALU(%)
53 W $$SHOWVALU(TOTAL)
54 W !,"% INACTIVE",?13 F ACCT=1,2,3,6,8 S %=$G(VALUE(ACCT)),%=$S('%:0,1:$G(INACT(ACCT))/%) W $J(%,11,2)
55 S %=$S('TOTVAL:0,1:TOTAL/TOTVAL) W $J(%,11,2)
56 S Y=$E(DATELONG,1,5)_"01" D DD^%DT
57 ;
58 ;*98 Showed correct range of 90 days for long supply on report section
59 ;
60 W !!?2,"LONG SUPPLY ITEMS AVERAGE FROM ",Y," TO ",$P(NOW,"@")," (>90 DAYS)",!,"# LONG SUPPLY",?13
61 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(LONGN(ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
62 W $J(TOTAL,11,0)
63 W !,"$ LONG SUPPLY",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(LONG(ACCT)),TOTAL=TOTAL+% W $$SHOWVALU(%)
64 W $$SHOWVALU(TOTAL)
65 W !,"% LONG SUPPLY",?13 F ACCT=1,2,3,6,8 S %=$G(VALUE(ACCT)),%=$S('%:0,1:$G(LONG(ACCT))/%) W $J(%,11,2)
66 S %=$S('TOTVAL:0,1:TOTAL/TOTVAL) W $J(%,11,2)
67 I $Y>(IOSL-7) W ! D:SCREEN P^PRCPUREP G:$G(PRCPFLAG) Q D H
68 W !!?2,"NONISSUABLE ITEMS ON ",$P(NOW,"@"),!,"# NONISSUABLE",?13
69 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(NONISSN(ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
70 W $J(TOTAL,11,0)
71 W !,"$ NONISSUABLE",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(NONISS(ACCT)),TOTAL=TOTAL+% W $$SHOWVALU(%)
72 W $$SHOWVALU(TOTAL)
73 W !,"% NONISSUABLE",?13 F ACCT=1,2,3,6,8 S %=$G(VALUE(ACCT)),%=$S('%:0,1:$G(NONISS(ACCT))/%) W $J(%,11,2)
74 S %=$S('TOTVAL:0,1:TOTAL/TOTVAL) W $J(%,11,2)
75 D END^PRCPUREP
76Q D ^%ZISC Q
77 ;
78 ;
79SHOWVALU(V1) ;show value
80 N % S %="+" S:+V1=0 %=" " I V1<0 S V1=-V1,%="-"
81 Q $J(V1,10,2)_%
82 ;
83 ;
84H ;heading
85 S %=NOW_" PAGE: "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
86 W $C(13),"STOCK STATUS REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
87 W !?5,"TRANSACTIONS FOR THE MONTH-YEAR: ",MONTH
88 W !,"SUMMARY",?14,$J("ACCT 1",11),$J("ACCT 2",11),$J("ACCT 3",11),$J("ACCT 6",11),$J("ACCT 8",11),$J("TOTAL",11)
89 S %="",$P(%,"-",81)="" W !,%
90 Q
Note: See TracBrowser for help on using the repository browser.