source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPENL1.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PRCPENL1 ;WISC/RFJ,DGL-edit inventory parameters (list manager) ; 7/21/99 9:53am
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7DISTRPTS ; build distribution points array
8 N %,DISTR
9 S LINE=LINE+1,COLUMN=1,CLREND=80
10 D SET^PRCPENLM("Distribution Points",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
11 S DISTR=0 F LINE=LINE+1:1 S DISTR=$O(^PRCP(445,PRCPINPT,2,DISTR)) Q:'DISTR D
12 . D SET^PRCPENLM(" : "_$$INVNAME^PRCPUX1(DISTR),LINE,COLUMN,CLREND)
13 . S %=$P($G(^PRCP(445,DISTR,0)),"^",3),%=$S(%="W":"WAREHOUSE",%="P":"PRIMARY",%="S":"SECONDARY",1:"<<NOT DEFINED>>")
14 . D SET^PRCPENLM(%,LINE,65,CLREND)
15 D SET^PRCPENLM("",LINE,COLUMN,CLREND)
16 Q
17 ;
18 ;
19STOCKED ; build stocked by array
20 N %,DISTR
21 S LINE=LINE+1,COLUMN=1,CLREND=80
22 D SET^PRCPENLM("Stocked By Points",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
23 S DISTR=0 F LINE=LINE+1:1 S DISTR=$O(^PRCP(445,"AB",PRCPINPT,DISTR)) Q:'DISTR D
24 . D SET^PRCPENLM(" : "_$$INVNAME^PRCPUX1(DISTR),LINE,COLUMN,CLREND)
25 . S %=$P($G(^PRCP(445,DISTR,0)),"^",3),%=$S(%="W":"WAREHOUSE",%="P":"PRIMARY",%="S":"SECONDARY",1:"<<NOT DEFINED>>")
26 . D SET^PRCPENLM(%,LINE,65,CLREND)
27 Q
28 ;
29 ;
30PURGE ; build purge date array
31 S LINE=LINE+1,COLUMN=1,CLREND=80
32 D SET^PRCPENLM("Purge Information",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
33 D SET^PRCPENLM(" Automatic Purge",LINE,20,CLREND,7.9)
34 D SET^PRCPENLM("Usage Last Purged ",LINE+1,COLUMN,CLREND,7.5)
35 D SET^PRCPENLM("Receipts Last Purged ",LINE+2,COLUMN,CLREND,7.6)
36 D SET^PRCPENLM("Transaction Register Last Purged ",LINE+3,COLUMN,CLREND,7.7)
37 D SET^PRCPENLM("Distribution Statistics Last Purged ",LINE+4,COLUMN,CLREND,7.8)
38 S LINE=LINE+4
39 Q
40 ;
41 ;
42FCP ; build fund control point array
43 N FCP,STATION
44 S LINE=LINE+1,COLUMN=1,CLREND=80
45 D SET^PRCPENLM("Fund Control Points",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
46 S STATION=0 F S STATION=$O(^PRC(420,"AE",STATION)) Q:'STATION S FCP=0 F S FCP=$O(^PRC(420,"AE",STATION,PRCPINPT,FCP)) Q:'FCP D
47 . S LINE=LINE+1
48 . D SET^PRCPENLM(" : "_$P($G(^PRC(420,STATION,1,FCP,0)),"^"),LINE,COLUMN,CLREND)
49 S LINE=LINE+1
50 D SET^PRCPENLM("",LINE,COLUMN,CLREND)
51 Q
52 ;
53 ;
54MISCOSTS ; build mis costing section array
55 N %,SECT
56 S LINE=LINE+1,COLUMN=1,CLREND=80
57 D SET^PRCPENLM("MIS Costing Section",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
58 S SECT=0 F LINE=LINE+1:1 S SECT=$O(^PRCP(445,PRCPINPT,3,SECT)) Q:'SECT D
59 . S %=$G(^PRCP(445,PRCPINPT,3,SECT,0))
60 . D SET^PRCPENLM(" : "_$P($G(^DIC(49,+$P(%,"^"),0)),"^"),LINE,COLUMN,CLREND)
61 . D SET^PRCPENLM($J($P(%,"^",2),5)_" %",LINE,65,CLREND)
62 D SET^PRCPENLM("",LINE,COLUMN,CLREND)
63 Q
Note: See TracBrowser for help on using the repository browser.