64 lines
2.6 KiB
Mathematica
64 lines
2.6 KiB
Mathematica
PRCPENL1 ;WISC/RFJ,DGL-edit inventory parameters (list manager) ; 7/21/99 9:53am
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
DISTRPTS ; build distribution points array
|
|
N %,DISTR
|
|
S LINE=LINE+1,COLUMN=1,CLREND=80
|
|
D SET^PRCPENLM("Distribution Points",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
|
|
S DISTR=0 F LINE=LINE+1:1 S DISTR=$O(^PRCP(445,PRCPINPT,2,DISTR)) Q:'DISTR D
|
|
. D SET^PRCPENLM(" : "_$$INVNAME^PRCPUX1(DISTR),LINE,COLUMN,CLREND)
|
|
. S %=$P($G(^PRCP(445,DISTR,0)),"^",3),%=$S(%="W":"WAREHOUSE",%="P":"PRIMARY",%="S":"SECONDARY",1:"<<NOT DEFINED>>")
|
|
. D SET^PRCPENLM(%,LINE,65,CLREND)
|
|
D SET^PRCPENLM("",LINE,COLUMN,CLREND)
|
|
Q
|
|
;
|
|
;
|
|
STOCKED ; build stocked by array
|
|
N %,DISTR
|
|
S LINE=LINE+1,COLUMN=1,CLREND=80
|
|
D SET^PRCPENLM("Stocked By Points",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
|
|
S DISTR=0 F LINE=LINE+1:1 S DISTR=$O(^PRCP(445,"AB",PRCPINPT,DISTR)) Q:'DISTR D
|
|
. D SET^PRCPENLM(" : "_$$INVNAME^PRCPUX1(DISTR),LINE,COLUMN,CLREND)
|
|
. S %=$P($G(^PRCP(445,DISTR,0)),"^",3),%=$S(%="W":"WAREHOUSE",%="P":"PRIMARY",%="S":"SECONDARY",1:"<<NOT DEFINED>>")
|
|
. D SET^PRCPENLM(%,LINE,65,CLREND)
|
|
Q
|
|
;
|
|
;
|
|
PURGE ; build purge date array
|
|
S LINE=LINE+1,COLUMN=1,CLREND=80
|
|
D SET^PRCPENLM("Purge Information",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
|
|
D SET^PRCPENLM(" Automatic Purge",LINE,20,CLREND,7.9)
|
|
D SET^PRCPENLM("Usage Last Purged ",LINE+1,COLUMN,CLREND,7.5)
|
|
D SET^PRCPENLM("Receipts Last Purged ",LINE+2,COLUMN,CLREND,7.6)
|
|
D SET^PRCPENLM("Transaction Register Last Purged ",LINE+3,COLUMN,CLREND,7.7)
|
|
D SET^PRCPENLM("Distribution Statistics Last Purged ",LINE+4,COLUMN,CLREND,7.8)
|
|
S LINE=LINE+4
|
|
Q
|
|
;
|
|
;
|
|
FCP ; build fund control point array
|
|
N FCP,STATION
|
|
S LINE=LINE+1,COLUMN=1,CLREND=80
|
|
D SET^PRCPENLM("Fund Control Points",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
|
|
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
|
|
. S LINE=LINE+1
|
|
. D SET^PRCPENLM(" : "_$P($G(^PRC(420,STATION,1,FCP,0)),"^"),LINE,COLUMN,CLREND)
|
|
S LINE=LINE+1
|
|
D SET^PRCPENLM("",LINE,COLUMN,CLREND)
|
|
Q
|
|
;
|
|
;
|
|
MISCOSTS ; build mis costing section array
|
|
N %,SECT
|
|
S LINE=LINE+1,COLUMN=1,CLREND=80
|
|
D SET^PRCPENLM("MIS Costing Section",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
|
|
S SECT=0 F LINE=LINE+1:1 S SECT=$O(^PRCP(445,PRCPINPT,3,SECT)) Q:'SECT D
|
|
. S %=$G(^PRCP(445,PRCPINPT,3,SECT,0))
|
|
. D SET^PRCPENLM(" : "_$P($G(^DIC(49,+$P(%,"^"),0)),"^"),LINE,COLUMN,CLREND)
|
|
. D SET^PRCPENLM($J($P(%,"^",2),5)_" %",LINE,65,CLREND)
|
|
D SET^PRCPENLM("",LINE,COLUMN,CLREND)
|
|
Q
|