source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPENLM.m@ 1694

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

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1PRCPENLM ;WISC/RFJ-edit inventory parameters (list manager);06 Jan 94 ; 6/23/99 10:52am
2V ;;5.1;IFCAP;**1**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 D ^PRCPUSEL Q:'$G(PRCP("I"))
5ENTERNEW ; this entry point bypasses prcpusel
6 N CLREND,COLUMN,LINE,PRCPINPT,PRCPDATA,PRCPSU,PRCPTYPE,X
7 K X S X(1)="You have the option to edit ALL "_$S(PRCP("DPTYPE")="W":"WAREHOUSE",PRCP("DPTYPE")="P":"PRIMARY",1:"SECONDARY")_" inventory points you have access to." D DISPLAY^PRCPUX2(2,40,.X)
8 S PRCPSU=1 ; Screen for auth. users only
9 I $G(^VA(200,DUZ,400))+0=4 S PRCPSU=0 ; Supply Manager-no screen
10 F S PRCPINPT=$$INVPT^PRCPUINV(PRC("SITE"),PRCP("DPTYPE"),1,PRCPSU,"") Q:'PRCPINPT D
11 . S PRCPTYPE=$P($G(^PRCP(445,PRCPINPT,0)),"^",3)
12 . L +^PRCP(445,PRCPINPT,0):1 I '$T D SHOWWHO^PRCPULOC(445,PRCPINPT_"-0",0) Q
13 . I PRCPTYPE="S" L +^PRCP(445,PRCPINPT,5):1 I '$T D Q
14 . . D SHOWWHO^PRCPULOC(445,PRCPINPT_"-0",5)
15 . . L -^PRCP(445,PRCPINPT,0)
16 . D ADD^PRCPULOC(445,PRCPINPT_"-0",0,"Enter/Edit Inventory Parameters")
17 . I PRCPTYPE="S" D ADD^PRCPULOC(445,PRCPINPT_"-5",0,"Enter/Edit Inventory Parameters")
18 . D EN^VALM("PRCP INVENTORY PARAMETERS")
19 . D CLEAR^PRCPULOC(445,PRCPINPT_"-0",0)
20 . L -^PRCP(445,PRCPINPT,0)
21 . I PRCPTYPE="S" D
22 . . D CLEAR^PRCPULOC(445,PRCPINPT_"-5",0)
23 . . L -^PRCP(445,PRCPINPT,5)
24 Q
25 ;
26 ;
27HDR ; build header
28 S VALMHDR(1)="INVENTORY POINT: "_$$INVNAME^PRCPUX1(PRCPINPT)_" TOTAL NUMBER OF ITEMS: "_+$P($G(^PRCP(445,PRCPINPT,1,0)),"^",4)
29 Q
30 ;
31 ;
32INIT ; build array
33 K PRCPDATA,^TMP($J,"PRCPENLM")
34 D DIQ(".01:22")
35 D DESCRIP,SPECIAL,FLAGS,USERS
36 I PRCPTYPE="W"!(PRCPTYPE="P") D DISTRPTS^PRCPENL1
37 I PRCPTYPE="P"!(PRCPTYPE="S") D STOCKED^PRCPENL1
38 I PRCPTYPE="W"!(PRCPTYPE="P") D FCP^PRCPENL1
39 I PRCPTYPE="S"!(PRCPTYPE="P") D MISCOSTS^PRCPENL1
40 D PURGE^PRCPENL1
41 S VALMCNT=LINE
42 Q
43 ;
44 ;
45DESCRIP ; build descriptive array
46 S LINE=1,COLUMN=1,CLREND=80
47 D SET("Description",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
48 D SET("Type of Inventory Point ",LINE+1,COLUMN,CLREND,.7)
49 D SET("Abbreviated Name ",LINE+2,COLUMN,CLREND,.8)
50 D SET("Keep Perpetual Inventory ",LINE+3,COLUMN,CLREND,.5)
51 D SET("Keep Transaction Register ",LINE+4,COLUMN,CLREND,.6)
52 D SET("",LINE+5,COLUMN,CLREND)
53 Q
54 ;
55 ;
56SPECIAL ; build special parameters array
57 N COUNT,ORD
58 S LINE=7,COLUMN=1,CLREND=80,ORD=0
59 D SET("Special Parameters",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
60 D SET("Months Inactive Before Item Deletion",LINE+1,COLUMN,CLREND,12)
61 I PRCPTYPE="W" D
62 . D SET("Cost Center ",LINE+2,COLUMN,CLREND,.9)
63 . D SET("Default Picking Ticket Printer ",LINE+3,COLUMN,CLREND,16)
64 . S LINE=LINE+3
65 I PRCPTYPE="P" D
66 . D SET("Primary Updated By Warehouse ",LINE+2,COLUMN,CLREND,14)
67 . D SET("Special Inventory Point Type ",LINE+3,COLUMN,CLREND,15)
68 . D SET("Department Number ",LINE+4,COLUMN,CLREND,5)
69 . D SET("Issue Book Sort ",LINE+5,COLUMN,CLREND,5.5)
70 . D SET("Regular Whse Issues Schedule ",LINE+6,COLUMN,CLREND,9)
71 . S LINE=LINE+6
72 . I $G(PRCPDATA(445,PRCPINPT,15,"E"))="SPD" S LINE=LINE+1 D SET("SPD Picking Ticket Printer ",LINE,COLUMN,CLREND,16)
73 I PRCPTYPE="S" D
74 . S ORD=$$SSCHK^PRCPENE1(PRCPINPT)
75 . I 'ORD D SET("Supply Station Provider ",LINE+2,COLUMN,CLREND,22)
76 . I ORD D SET("(Supply Station Provider) ",LINE+2,COLUMN,CLREND,22)
77 . S LINE=LINE+2
78 S LINE=LINE+1
79 D SET("",LINE,COLUMN,CLREND)
80 Q
81 ;
82 ;
83FLAGS ; build flags array
84 S LINE=LINE+1,COLUMN=1,CLREND=80
85 D SET("Flags",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
86 D SET("Print Emergency Stock Levels ",LINE+1,COLUMN,CLREND,7)
87 D SET("Automatic Purge ",LINE+2,COLUMN,CLREND,7.9)
88 S LINE=LINE+2
89 I PRCPTYPE="P" S LINE=LINE+1 D SET("Regular Whse Issues Due Date ",LINE,COLUMN,CLREND,10)
90 S LINE=LINE+1
91 D SET("",LINE,COLUMN,CLREND)
92 Q
93 ;
94 ;
95USERS ; build inventory users array
96 N USER
97 S LINE=LINE+1,COLUMN=1,CLREND=80
98 D SET("Inventory Users",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
99 S USER=0 F LINE=LINE+1:1 S USER=$O(^PRCP(445,PRCPINPT,4,USER)) Q:'USER D
100 . D SET(" : "_$$USER^PRCPUREP(USER),LINE,COLUMN,CLREND)
101 . I $$KEY^PRCPUREP("PRCP"_$TR(PRCPTYPE,"WSP","W2")_" MGRKEY",USER) D SET("*** MANAGER ***",LINE,65,CLREND)
102 D SET("",LINE,COLUMN,CLREND)
103 Q
104 ;
105 ;
106EXIT ; exit and clean up
107 K ^TMP($J,"PRCPENLM")
108 Q
109 ;
110 ;
111DIQ(DR) ; diq call to retrieve data for dr fields
112 N D0,DA,DIC,DIQ,DIQ2
113 S DA=PRCPINPT,DIQ(0)="E",DIC="^PRCP(445,",DIQ="PRCPDATA" D EN^DIQ1
114 Q
115 ;
116 ;
117SET(STRING,LINE,COLUMN,CLREND,FIELD,ON,OFF) ; set array
118 I $G(FIELD) S STRING=STRING_": "_$G(PRCPDATA(445,PRCPINPT,FIELD,"E"))
119 I STRING="" D SET^VALM10(LINE,$J("",80)) Q
120 I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
121 D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND))
122 I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLUMN,$L(STRING),ON,OFF)
123 Q
124 ;
125 ;
126ADDNEW ; this entry point is called from the option file from ifcap
127 ; to set up new primary or warehouse inventory points
128 I '$G(PRC("SITE")) S PRCF("X")="S" D ^PRCFSITE
129 S DIR(0)="SO^W:Warehouse;P:Primary",DIR("A")="Select the type of inventory point to edit" D ^DIR K DIR I Y'="W",Y'="P" Q
130 S PRCP("DPTYPE")=Y
131 D ENTERNEW
132 K PRCP
133 G ADDNEW
Note: See TracBrowser for help on using the repository browser.