PRCPRINV ;WISC/RFJ/DGL/VAC-inventory control parameters report ; 2/27/07 8:46am
V ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
 ;Per VHA Directive 2004-038, this routine should not be modified.
 ;*98 Modified to accommodate On-Demand Items.
 ;*98 Modified for Total = ODI+Standard, rather than pull from 0 node
 D ^PRCPUSEL Q:'$G(PRCP("I"))
 N PRCPINPT,X,POP,ZTDESC,ZTRTN,ZTSAVE
 I "WP"[PRCP("DPTYPE") W !!,"--Press RETURN to print parameters for ",PRCP("IN"),"--" S PRCPINPT=$$TO^PRCPUDPT(PRCP("I")) I PRCPINPT["^" Q
 I '$G(PRCPINPT) S PRCPINPT=PRCP("I")
 W !!,"Print control parameters for ",$$INVNAME^PRCPUX1(PRCPINPT),!
 S %ZIS="Q" D ^%ZIS Q:POP  I $D(IO("Q")) D  D ^%ZTLOAD K IO("Q"),ZTSK Q
 .   S ZTDESC="Inventory Parameters",ZTRTN="DQ^PRCPRINV"
 .   S ZTSAVE("PRCP*")="",ZTSAVE("ZTREQ")="@"
 W !!,"<*> please wait <*>"
DQ ;  queue starts here
 N %,%I,DATA,DISTR,FCP,ITEMCTR,MGRFLG,NOW,ODIFLG,ODITEM,PAGE,PRCPFLAG,PRCPNAME,PRCPTYPE,SCREEN,SECT,STATION,STDITEM,USER,X,Y
 S DATA=$G(^PRCP(445,PRCPINPT,0)),PRCPNAME=$P(DATA,"^"),PRCPTYPE=$P(DATA,"^",3)
 D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
 W !!,"TYPE OF INVENTORY POINT",?30,": ",$S(PRCPTYPE="W":"SUPPLY WAREHOUSE",PRCPTYPE="P":"PRIMARY",PRCPTYPE="S":"SECONDARY",1:"<<NOT DEFINED>>")
 W !,"ABBREVIATED NAME",?30,": ",$P(DATA,"^",5)
 I PRCPTYPE="W"!(PRCPTYPE="P") W !,"COST CENTER",?30,": ",$E($P($G(^PRCD(420.1,+$P(DATA,"^",7),0)),"^"),1,48)
 W !,"KEEP PERPETUAL INVENTORY",?30,": ",$S($P(DATA,"^",2)="Y":"YES",1:"NO")
 W !,"KEEP TRANSACTION/USAGE HISTORY",?30,": ",$S($P(DATA,"^",6)="Y":"YES",1:"NO")
 I $Y>(IOSL-7) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
 I PRCPTYPE="P" D
 .   W !,"PRIMARY UPDATED BY WAREHOUSE",?30,": ",$S($P(DATA,"^",16)="N":"NO",1:"YES")
 .   W !,"SPECIAL INVENTORY POINT TYPE",?30,": ",$S($P(DATA,"^",20)="D":"DRUG ACCOUNTABILITY",$P(DATA,"^",20)="S":"SPD",1:"")
 .   I $P(DATA,"^",20)="S" W !,"SPD PICKING TICKET PRINTER: ",$P($G(^PRCP(445,PRCPINPT,"DEV")),"^")
 .   W !,"ISSUE BOOK SORT",?30,": ",$S($P(DATA,"^",10)="A":"ALPHA SORT",$P(DATA,"^",10)="N":"NSN SORT",1:"")
 .   W !,"REGULAR WHSE ISSUES SCHEDULE",?30,": ",$S($P(DATA,"^",4)="W":"WEEKLY",$P(DATA,"^",4)=2:"EVERY 2 WEEKS",$P(DATA,"^",4)="M":"MONTHLY",$P(DATA,"^",4)="O":"OTHER",1:"")
 .   W !,"DEPARTMENT NUMBER",?30,": ",$P(DATA,"^",8)
 W !,"MONTHS INACTIVE ITEM DELETION",?30,": ",$P(DATA,"^",13)
 ;Count number of on-demand and standard items
 S (ODITEM,STDITEM,ITEMCTR)=0
 F  S ITEMCTR=$O(^PRCP(445,PRCPINPT,1,ITEMCTR)) Q:+ITEMCTR=0  D
 .S ODIFLG=$$ODITEM^PRCPUX2(PRCPINPT,ITEMCTR)
 .I ODIFLG="Y" S ODITEM=ODITEM+1 Q
 .S STDITEM=STDITEM+1
 I PRCPTYPE'="W" D
 .W !,"TOTAL STANDARD ITEMS",?30,": ",STDITEM
 .I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
 .W !,"TOTAL ON-DEMAND ITEMS",?30,": ",ODITEM
 .I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
 ; the following line was re-written with patch PRC*5.1*98
 ;W !,"TOTAL NUMBER OF ITEMS STORED",?30,": ",+$P($G(^PRCP(445,PRCPINPT,1,0)),"^",4)
 W !,"TOTAL NUMBER OF ITEMS STORED",?30,": ",STDITEM+ODITEM
 I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
 I PRCPTYPE="W"!(PRCPTYPE="P") D
 .   W !!,"FUND CONTROL POINTS",?30,": "
 .   S STATION=0 F  S STATION=$O(^PRC(420,"AE",STATION)) Q:'STATION!($G(PRCPFLAG))  S FCP=0 F  S FCP=$O(^PRC(420,"AE",STATION,PRCPINPT,FCP)) Q:'FCP!($G(PRCPFLAG))  D
 .   .   W $P($G(^PRC(420,STATION,1,FCP,0)),"^")
 .   .   I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG)  D H
 .   .   W !?32
 I $G(PRCPFLAG) D Q Q
 I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
 I PRCPTYPE="S"!(PRCPTYPE="P") D
 .   W !!,"MIS COSTING SECTION",?30,": "
 .   S SECT=0 F  S SECT=$O(^PRCP(445,PRCPINPT,3,SECT)) Q:'SECT!($G(PRCPFLAG))  D
 .   .   S %=$G(^PRCP(445,PRCPINPT,3,SECT,0))
 .   .   W $E($P($G(^DIC(49,+$P(%,"^"),0)),"^"),1,30),?64,$J($P(%,"^",2),5)," %"
 .   .   I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG)  D H
 .   .   W !?32
 I $G(PRCPFLAG) D Q Q
 I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
 W !!,"INVENTORY USERS",?30,": "
 S USER=0 F  S USER=$O(^PRCP(445,PRCPINPT,4,USER)) Q:'USER!($G(PRCPFLAG))  D
 .   S MGRFLG=""
 .   W $E($$USER^PRCPUREP(USER),1,30)
 .   I $$KEY^PRCPUREP("PRCP"_$S(PRCPTYPE="P":"",PRCPTYPE="W":"W",PRCPTYPE="S":"2",1:"?")_" MGRKEY",USER) S MGRFLG="**MANAGER**"
 .   I $D(^PRCP(445,PRCPINPT,9,USER,0)) S MGRFLG="**ODI MGR**"
 .   W ?64,MGRFLG
 .   I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG)  D H
 .   W !?32
 I $G(PRCPFLAG) D Q Q
 I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
 I PRCPTYPE="W"!(PRCPTYPE="P") D
 .   W !!,"DISTRIBUTION POINTS",?30,": "
 .   S DISTR=0 F  S DISTR=$O(^PRCP(445,PRCPINPT,2,DISTR)) Q:'DISTR!($G(PRCPFLAG))  D
 .   .   S %=$P($G(^PRCP(445,DISTR,0)),"^",3)
 .   .   W $$INVNAME^PRCPUX1(DISTR),?64,$S(%="W":"SUPPLY WAREHOUSE",%="P":"PRIMARY",%="S":"SECONDARY",1:"<<NOT DEFINED>>")
 .   .   I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG)  D H
 .   .   W !?32
 I '$G(PRCPFLAG) D END^PRCPUREP
Q D ^%ZISC
 Q
 ;
 ;
H S %=NOW_"  PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
 W $C(13),"INVENTORY PARAMETERS FOR: ",$E(PRCPNAME,1,20),?(80-$L(%)),%
 S %="",$P(%,"-",81)=""
 W !,%
 Q