134 lines
5.2 KiB
Mathematica
134 lines
5.2 KiB
Mathematica
PRCPENLM ;WISC/RFJ-edit inventory parameters (list manager);06 Jan 94 ; 6/23/99 10:52am
|
|
V ;;5.1;IFCAP;**1**;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|
ENTERNEW ; this entry point bypasses prcpusel
|
|
N CLREND,COLUMN,LINE,PRCPINPT,PRCPDATA,PRCPSU,PRCPTYPE,X
|
|
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)
|
|
S PRCPSU=1 ; Screen for auth. users only
|
|
I $G(^VA(200,DUZ,400))+0=4 S PRCPSU=0 ; Supply Manager-no screen
|
|
F S PRCPINPT=$$INVPT^PRCPUINV(PRC("SITE"),PRCP("DPTYPE"),1,PRCPSU,"") Q:'PRCPINPT D
|
|
. S PRCPTYPE=$P($G(^PRCP(445,PRCPINPT,0)),"^",3)
|
|
. L +^PRCP(445,PRCPINPT,0):1 I '$T D SHOWWHO^PRCPULOC(445,PRCPINPT_"-0",0) Q
|
|
. I PRCPTYPE="S" L +^PRCP(445,PRCPINPT,5):1 I '$T D Q
|
|
. . D SHOWWHO^PRCPULOC(445,PRCPINPT_"-0",5)
|
|
. . L -^PRCP(445,PRCPINPT,0)
|
|
. D ADD^PRCPULOC(445,PRCPINPT_"-0",0,"Enter/Edit Inventory Parameters")
|
|
. I PRCPTYPE="S" D ADD^PRCPULOC(445,PRCPINPT_"-5",0,"Enter/Edit Inventory Parameters")
|
|
. D EN^VALM("PRCP INVENTORY PARAMETERS")
|
|
. D CLEAR^PRCPULOC(445,PRCPINPT_"-0",0)
|
|
. L -^PRCP(445,PRCPINPT,0)
|
|
. I PRCPTYPE="S" D
|
|
. . D CLEAR^PRCPULOC(445,PRCPINPT_"-5",0)
|
|
. . L -^PRCP(445,PRCPINPT,5)
|
|
Q
|
|
;
|
|
;
|
|
HDR ; build header
|
|
S VALMHDR(1)="INVENTORY POINT: "_$$INVNAME^PRCPUX1(PRCPINPT)_" TOTAL NUMBER OF ITEMS: "_+$P($G(^PRCP(445,PRCPINPT,1,0)),"^",4)
|
|
Q
|
|
;
|
|
;
|
|
INIT ; build array
|
|
K PRCPDATA,^TMP($J,"PRCPENLM")
|
|
D DIQ(".01:22")
|
|
D DESCRIP,SPECIAL,FLAGS,USERS
|
|
I PRCPTYPE="W"!(PRCPTYPE="P") D DISTRPTS^PRCPENL1
|
|
I PRCPTYPE="P"!(PRCPTYPE="S") D STOCKED^PRCPENL1
|
|
I PRCPTYPE="W"!(PRCPTYPE="P") D FCP^PRCPENL1
|
|
I PRCPTYPE="S"!(PRCPTYPE="P") D MISCOSTS^PRCPENL1
|
|
D PURGE^PRCPENL1
|
|
S VALMCNT=LINE
|
|
Q
|
|
;
|
|
;
|
|
DESCRIP ; build descriptive array
|
|
S LINE=1,COLUMN=1,CLREND=80
|
|
D SET("Description",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
|
|
D SET("Type of Inventory Point ",LINE+1,COLUMN,CLREND,.7)
|
|
D SET("Abbreviated Name ",LINE+2,COLUMN,CLREND,.8)
|
|
D SET("Keep Perpetual Inventory ",LINE+3,COLUMN,CLREND,.5)
|
|
D SET("Keep Transaction Register ",LINE+4,COLUMN,CLREND,.6)
|
|
D SET("",LINE+5,COLUMN,CLREND)
|
|
Q
|
|
;
|
|
;
|
|
SPECIAL ; build special parameters array
|
|
N COUNT,ORD
|
|
S LINE=7,COLUMN=1,CLREND=80,ORD=0
|
|
D SET("Special Parameters",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
|
|
D SET("Months Inactive Before Item Deletion",LINE+1,COLUMN,CLREND,12)
|
|
I PRCPTYPE="W" D
|
|
. D SET("Cost Center ",LINE+2,COLUMN,CLREND,.9)
|
|
. D SET("Default Picking Ticket Printer ",LINE+3,COLUMN,CLREND,16)
|
|
. S LINE=LINE+3
|
|
I PRCPTYPE="P" D
|
|
. D SET("Primary Updated By Warehouse ",LINE+2,COLUMN,CLREND,14)
|
|
. D SET("Special Inventory Point Type ",LINE+3,COLUMN,CLREND,15)
|
|
. D SET("Department Number ",LINE+4,COLUMN,CLREND,5)
|
|
. D SET("Issue Book Sort ",LINE+5,COLUMN,CLREND,5.5)
|
|
. D SET("Regular Whse Issues Schedule ",LINE+6,COLUMN,CLREND,9)
|
|
. S LINE=LINE+6
|
|
. I $G(PRCPDATA(445,PRCPINPT,15,"E"))="SPD" S LINE=LINE+1 D SET("SPD Picking Ticket Printer ",LINE,COLUMN,CLREND,16)
|
|
I PRCPTYPE="S" D
|
|
. S ORD=$$SSCHK^PRCPENE1(PRCPINPT)
|
|
. I 'ORD D SET("Supply Station Provider ",LINE+2,COLUMN,CLREND,22)
|
|
. I ORD D SET("(Supply Station Provider) ",LINE+2,COLUMN,CLREND,22)
|
|
. S LINE=LINE+2
|
|
S LINE=LINE+1
|
|
D SET("",LINE,COLUMN,CLREND)
|
|
Q
|
|
;
|
|
;
|
|
FLAGS ; build flags array
|
|
S LINE=LINE+1,COLUMN=1,CLREND=80
|
|
D SET("Flags",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
|
|
D SET("Print Emergency Stock Levels ",LINE+1,COLUMN,CLREND,7)
|
|
D SET("Automatic Purge ",LINE+2,COLUMN,CLREND,7.9)
|
|
S LINE=LINE+2
|
|
I PRCPTYPE="P" S LINE=LINE+1 D SET("Regular Whse Issues Due Date ",LINE,COLUMN,CLREND,10)
|
|
S LINE=LINE+1
|
|
D SET("",LINE,COLUMN,CLREND)
|
|
Q
|
|
;
|
|
;
|
|
USERS ; build inventory users array
|
|
N USER
|
|
S LINE=LINE+1,COLUMN=1,CLREND=80
|
|
D SET("Inventory Users",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
|
|
S USER=0 F LINE=LINE+1:1 S USER=$O(^PRCP(445,PRCPINPT,4,USER)) Q:'USER D
|
|
. D SET(" : "_$$USER^PRCPUREP(USER),LINE,COLUMN,CLREND)
|
|
. I $$KEY^PRCPUREP("PRCP"_$TR(PRCPTYPE,"WSP","W2")_" MGRKEY",USER) D SET("*** MANAGER ***",LINE,65,CLREND)
|
|
D SET("",LINE,COLUMN,CLREND)
|
|
Q
|
|
;
|
|
;
|
|
EXIT ; exit and clean up
|
|
K ^TMP($J,"PRCPENLM")
|
|
Q
|
|
;
|
|
;
|
|
DIQ(DR) ; diq call to retrieve data for dr fields
|
|
N D0,DA,DIC,DIQ,DIQ2
|
|
S DA=PRCPINPT,DIQ(0)="E",DIC="^PRCP(445,",DIQ="PRCPDATA" D EN^DIQ1
|
|
Q
|
|
;
|
|
;
|
|
SET(STRING,LINE,COLUMN,CLREND,FIELD,ON,OFF) ; set array
|
|
I $G(FIELD) S STRING=STRING_": "_$G(PRCPDATA(445,PRCPINPT,FIELD,"E"))
|
|
I STRING="" D SET^VALM10(LINE,$J("",80)) Q
|
|
I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
|
|
D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND))
|
|
I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLUMN,$L(STRING),ON,OFF)
|
|
Q
|
|
;
|
|
;
|
|
ADDNEW ; this entry point is called from the option file from ifcap
|
|
; to set up new primary or warehouse inventory points
|
|
I '$G(PRC("SITE")) S PRCF("X")="S" D ^PRCFSITE
|
|
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
|
|
S PRCP("DPTYPE")=Y
|
|
D ENTERNEW
|
|
K PRCP
|
|
G ADDNEW
|