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