source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRINV.m@ 846

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

initial load of WorldVistAEHR
File size: 5.0 KB
RevLine 
[613]1PRCPRINV ;WISC/RFJ/DGL/VAC-inventory control parameters report ; 2/27/07 8:46am
2V ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;*98 Modified to accommodate On-Demand Items.
5 ;*98 Modified for Total = ODI+Standard, rather than pull from 0 node
6 D ^PRCPUSEL Q:'$G(PRCP("I"))
7 N PRCPINPT,X,POP,ZTDESC,ZTRTN,ZTSAVE
8 I "WP"[PRCP("DPTYPE") W !!,"--Press RETURN to print parameters for ",PRCP("IN"),"--" S PRCPINPT=$$TO^PRCPUDPT(PRCP("I")) I PRCPINPT["^" Q
9 I '$G(PRCPINPT) S PRCPINPT=PRCP("I")
10 W !!,"Print control parameters for ",$$INVNAME^PRCPUX1(PRCPINPT),!
11 S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
12 . S ZTDESC="Inventory Parameters",ZTRTN="DQ^PRCPRINV"
13 . S ZTSAVE("PRCP*")="",ZTSAVE("ZTREQ")="@"
14 W !!,"<*> please wait <*>"
15DQ ; queue starts here
16 N %,%I,DATA,DISTR,FCP,ITEMCTR,MGRFLG,NOW,ODIFLG,ODITEM,PAGE,PRCPFLAG,PRCPNAME,PRCPTYPE,SCREEN,SECT,STATION,STDITEM,USER,X,Y
17 S DATA=$G(^PRCP(445,PRCPINPT,0)),PRCPNAME=$P(DATA,"^"),PRCPTYPE=$P(DATA,"^",3)
18 D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
19 W !!,"TYPE OF INVENTORY POINT",?30,": ",$S(PRCPTYPE="W":"SUPPLY WAREHOUSE",PRCPTYPE="P":"PRIMARY",PRCPTYPE="S":"SECONDARY",1:"<<NOT DEFINED>>")
20 W !,"ABBREVIATED NAME",?30,": ",$P(DATA,"^",5)
21 I PRCPTYPE="W"!(PRCPTYPE="P") W !,"COST CENTER",?30,": ",$E($P($G(^PRCD(420.1,+$P(DATA,"^",7),0)),"^"),1,48)
22 W !,"KEEP PERPETUAL INVENTORY",?30,": ",$S($P(DATA,"^",2)="Y":"YES",1:"NO")
23 W !,"KEEP TRANSACTION/USAGE HISTORY",?30,": ",$S($P(DATA,"^",6)="Y":"YES",1:"NO")
24 I $Y>(IOSL-7) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
25 I PRCPTYPE="P" D
26 . W !,"PRIMARY UPDATED BY WAREHOUSE",?30,": ",$S($P(DATA,"^",16)="N":"NO",1:"YES")
27 . W !,"SPECIAL INVENTORY POINT TYPE",?30,": ",$S($P(DATA,"^",20)="D":"DRUG ACCOUNTABILITY",$P(DATA,"^",20)="S":"SPD",1:"")
28 . I $P(DATA,"^",20)="S" W !,"SPD PICKING TICKET PRINTER: ",$P($G(^PRCP(445,PRCPINPT,"DEV")),"^")
29 . W !,"ISSUE BOOK SORT",?30,": ",$S($P(DATA,"^",10)="A":"ALPHA SORT",$P(DATA,"^",10)="N":"NSN SORT",1:"")
30 . 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:"")
31 . W !,"DEPARTMENT NUMBER",?30,": ",$P(DATA,"^",8)
32 W !,"MONTHS INACTIVE ITEM DELETION",?30,": ",$P(DATA,"^",13)
33 ;Count number of on-demand and standard items
34 S (ODITEM,STDITEM,ITEMCTR)=0
35 F S ITEMCTR=$O(^PRCP(445,PRCPINPT,1,ITEMCTR)) Q:+ITEMCTR=0 D
36 .S ODIFLG=$$ODITEM^PRCPUX2(PRCPINPT,ITEMCTR)
37 .I ODIFLG="Y" S ODITEM=ODITEM+1 Q
38 .S STDITEM=STDITEM+1
39 I PRCPTYPE'="W" D
40 .W !,"TOTAL STANDARD ITEMS",?30,": ",STDITEM
41 .I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
42 .W !,"TOTAL ON-DEMAND ITEMS",?30,": ",ODITEM
43 .I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
44 ; the following line was re-written with patch PRC*5.1*98
45 ;W !,"TOTAL NUMBER OF ITEMS STORED",?30,": ",+$P($G(^PRCP(445,PRCPINPT,1,0)),"^",4)
46 W !,"TOTAL NUMBER OF ITEMS STORED",?30,": ",STDITEM+ODITEM
47 I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
48 I PRCPTYPE="W"!(PRCPTYPE="P") D
49 . W !!,"FUND CONTROL POINTS",?30,": "
50 . 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
51 . . W $P($G(^PRC(420,STATION,1,FCP,0)),"^")
52 . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
53 . . W !?32
54 I $G(PRCPFLAG) D Q Q
55 I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
56 I PRCPTYPE="S"!(PRCPTYPE="P") D
57 . W !!,"MIS COSTING SECTION",?30,": "
58 . S SECT=0 F S SECT=$O(^PRCP(445,PRCPINPT,3,SECT)) Q:'SECT!($G(PRCPFLAG)) D
59 . . S %=$G(^PRCP(445,PRCPINPT,3,SECT,0))
60 . . W $E($P($G(^DIC(49,+$P(%,"^"),0)),"^"),1,30),?64,$J($P(%,"^",2),5)," %"
61 . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
62 . . W !?32
63 I $G(PRCPFLAG) D Q Q
64 I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
65 W !!,"INVENTORY USERS",?30,": "
66 S USER=0 F S USER=$O(^PRCP(445,PRCPINPT,4,USER)) Q:'USER!($G(PRCPFLAG)) D
67 . S MGRFLG=""
68 . W $E($$USER^PRCPUREP(USER),1,30)
69 . I $$KEY^PRCPUREP("PRCP"_$S(PRCPTYPE="P":"",PRCPTYPE="W":"W",PRCPTYPE="S":"2",1:"?")_" MGRKEY",USER) S MGRFLG="**MANAGER**"
70 . I $D(^PRCP(445,PRCPINPT,9,USER,0)) S MGRFLG="**ODI MGR**"
71 . W ?64,MGRFLG
72 . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
73 . W !?32
74 I $G(PRCPFLAG) D Q Q
75 I $Y>(IOSL-6) D:SCREEN P^PRCPUREP G:$D(PRCPFLAG) Q D H
76 I PRCPTYPE="W"!(PRCPTYPE="P") D
77 . W !!,"DISTRIBUTION POINTS",?30,": "
78 . S DISTR=0 F S DISTR=$O(^PRCP(445,PRCPINPT,2,DISTR)) Q:'DISTR!($G(PRCPFLAG)) D
79 . . S %=$P($G(^PRCP(445,DISTR,0)),"^",3)
80 . . W $$INVNAME^PRCPUX1(DISTR),?64,$S(%="W":"SUPPLY WAREHOUSE",%="P":"PRIMARY",%="S":"SECONDARY",1:"<<NOT DEFINED>>")
81 . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
82 . . W !?32
83 I '$G(PRCPFLAG) D END^PRCPUREP
84Q D ^%ZISC
85 Q
86 ;
87 ;
88H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
89 W $C(13),"INVENTORY PARAMETERS FOR: ",$E(PRCPNAME,1,20),?(80-$L(%)),%
90 S %="",$P(%,"-",81)=""
91 W !,%
92 Q
Note: See TracBrowser for help on using the repository browser.