| 1 | PRCPENL1 ;WISC/RFJ,DGL-edit inventory parameters (list manager) ; 7/21/99 9:53am
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | DISTRPTS ; 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 | ;
|
|---|
| 19 | STOCKED ; 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 | ;
|
|---|
| 30 | PURGE ; 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 | ;
|
|---|
| 42 | FCP ; 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 | ;
|
|---|
| 54 | MISCOSTS ; 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
|
|---|
