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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPENLM 5432 printed Apr 09, 2024@21:04:20 Page 2
PRCPENLM ;WISC/RFJ-edit inventory parameters (list manager);06 Jan 94 ; 6/23/99 10:52am
V ;;5.1;IFCAP;**1**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 DO ^PRCPUSEL
if '$GET(PRCP("I"))
QUIT
ENTERNEW ; this entry point bypasses prcpusel
+1 NEW CLREND,COLUMN,LINE,PRCPINPT,PRCPDATA,PRCPSU,PRCPTYPE,X
+2 KILL X
SET X(1)="You have the option to edit ALL "_$SELECT(PRCP("DPTYPE")="W":"WAREHOUSE",PRCP("DPTYPE")="P":"PRIMARY",1:"SECONDARY")_" inventory points you have access to."
DO DISPLAY^PRCPUX2(2,40,.X)
+3 ; Screen for auth. users only
SET PRCPSU=1
+4 ; Supply Manager-no screen
IF $GET(^VA(200,DUZ,400))+0=4
SET PRCPSU=0
+5 FOR
SET PRCPINPT=$$INVPT^PRCPUINV(PRC("SITE"),PRCP("DPTYPE"),1,PRCPSU,"")
if 'PRCPINPT
QUIT
Begin DoDot:1
+6 SET PRCPTYPE=$PIECE($GET(^PRCP(445,PRCPINPT,0)),"^",3)
+7 LOCK +^PRCP(445,PRCPINPT,0):1
IF '$TEST
DO SHOWWHO^PRCPULOC(445,PRCPINPT_"-0",0)
QUIT
+8 IF PRCPTYPE="S"
LOCK +^PRCP(445,PRCPINPT,5):1
IF '$TEST
Begin DoDot:2
+9 DO SHOWWHO^PRCPULOC(445,PRCPINPT_"-0",5)
+10 LOCK -^PRCP(445,PRCPINPT,0)
End DoDot:2
QUIT
+11 DO ADD^PRCPULOC(445,PRCPINPT_"-0",0,"Enter/Edit Inventory Parameters")
+12 IF PRCPTYPE="S"
DO ADD^PRCPULOC(445,PRCPINPT_"-5",0,"Enter/Edit Inventory Parameters")
+13 DO EN^VALM("PRCP INVENTORY PARAMETERS")
+14 DO CLEAR^PRCPULOC(445,PRCPINPT_"-0",0)
+15 LOCK -^PRCP(445,PRCPINPT,0)
+16 IF PRCPTYPE="S"
Begin DoDot:2
+17 DO CLEAR^PRCPULOC(445,PRCPINPT_"-5",0)
+18 LOCK -^PRCP(445,PRCPINPT,5)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+21 ;
HDR ; build header
+1 SET VALMHDR(1)="INVENTORY POINT: "_$$INVNAME^PRCPUX1(PRCPINPT)_" TOTAL NUMBER OF ITEMS: "_+$PIECE($GET(^PRCP(445,PRCPINPT,1,0)),"^",4)
+2 QUIT
+3 ;
+4 ;
INIT ; build array
+1 KILL PRCPDATA,^TMP($JOB,"PRCPENLM")
+2 DO DIQ(".01:22")
+3 DO DESCRIP
DO SPECIAL
DO FLAGS
DO USERS
+4 IF PRCPTYPE="W"!(PRCPTYPE="P")
DO DISTRPTS^PRCPENL1
+5 IF PRCPTYPE="P"!(PRCPTYPE="S")
DO STOCKED^PRCPENL1
+6 IF PRCPTYPE="W"!(PRCPTYPE="P")
DO FCP^PRCPENL1
+7 IF PRCPTYPE="S"!(PRCPTYPE="P")
DO MISCOSTS^PRCPENL1
+8 DO PURGE^PRCPENL1
+9 SET VALMCNT=LINE
+10 QUIT
+11 ;
+12 ;
DESCRIP ; build descriptive array
+1 SET LINE=1
SET COLUMN=1
SET CLREND=80
+2 DO SET("Description",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
+3 DO SET("Type of Inventory Point ",LINE+1,COLUMN,CLREND,.7)
+4 DO SET("Abbreviated Name ",LINE+2,COLUMN,CLREND,.8)
+5 DO SET("Keep Perpetual Inventory ",LINE+3,COLUMN,CLREND,.5)
+6 DO SET("Keep Transaction Register ",LINE+4,COLUMN,CLREND,.6)
+7 DO SET("",LINE+5,COLUMN,CLREND)
+8 QUIT
+9 ;
+10 ;
SPECIAL ; build special parameters array
+1 NEW COUNT,ORD
+2 SET LINE=7
SET COLUMN=1
SET CLREND=80
SET ORD=0
+3 DO SET("Special Parameters",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
+4 DO SET("Months Inactive Before Item Deletion",LINE+1,COLUMN,CLREND,12)
+5 IF PRCPTYPE="W"
Begin DoDot:1
+6 DO SET("Cost Center ",LINE+2,COLUMN,CLREND,.9)
+7 DO SET("Default Picking Ticket Printer ",LINE+3,COLUMN,CLREND,16)
+8 SET LINE=LINE+3
End DoDot:1
+9 IF PRCPTYPE="P"
Begin DoDot:1
+10 DO SET("Primary Updated By Warehouse ",LINE+2,COLUMN,CLREND,14)
+11 DO SET("Special Inventory Point Type ",LINE+3,COLUMN,CLREND,15)
+12 DO SET("Department Number ",LINE+4,COLUMN,CLREND,5)
+13 DO SET("Issue Book Sort ",LINE+5,COLUMN,CLREND,5.5)
+14 DO SET("Regular Whse Issues Schedule ",LINE+6,COLUMN,CLREND,9)
+15 SET LINE=LINE+6
+16 IF $GET(PRCPDATA(445,PRCPINPT,15,"E"))="SPD"
SET LINE=LINE+1
DO SET("SPD Picking Ticket Printer ",LINE,COLUMN,CLREND,16)
End DoDot:1
+17 IF PRCPTYPE="S"
Begin DoDot:1
+18 SET ORD=$$SSCHK^PRCPENE1(PRCPINPT)
+19 IF 'ORD
DO SET("Supply Station Provider ",LINE+2,COLUMN,CLREND,22)
+20 IF ORD
DO SET("(Supply Station Provider) ",LINE+2,COLUMN,CLREND,22)
+21 SET LINE=LINE+2
End DoDot:1
+22 SET LINE=LINE+1
+23 DO SET("",LINE,COLUMN,CLREND)
+24 QUIT
+25 ;
+26 ;
FLAGS ; build flags array
+1 SET LINE=LINE+1
SET COLUMN=1
SET CLREND=80
+2 DO SET("Flags",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
+3 DO SET("Print Emergency Stock Levels ",LINE+1,COLUMN,CLREND,7)
+4 DO SET("Automatic Purge ",LINE+2,COLUMN,CLREND,7.9)
+5 SET LINE=LINE+2
+6 IF PRCPTYPE="P"
SET LINE=LINE+1
DO SET("Regular Whse Issues Due Date ",LINE,COLUMN,CLREND,10)
+7 SET LINE=LINE+1
+8 DO SET("",LINE,COLUMN,CLREND)
+9 QUIT
+10 ;
+11 ;
USERS ; build inventory users array
+1 NEW USER
+2 SET LINE=LINE+1
SET COLUMN=1
SET CLREND=80
+3 DO SET("Inventory Users",LINE,COLUMN,CLREND,0,IORVON,IORVOFF)
+4 SET USER=0
FOR LINE=LINE+1:1
SET USER=$ORDER(^PRCP(445,PRCPINPT,4,USER))
if 'USER
QUIT
Begin DoDot:1
+5 DO SET(" : "_$$USER^PRCPUREP(USER),LINE,COLUMN,CLREND)
+6 IF $$KEY^PRCPUREP("PRCP"_$TRANSLATE(PRCPTYPE,"WSP","W2")_" MGRKEY",USER)
DO SET("*** MANAGER ***",LINE,65,CLREND)
End DoDot:1
+7 DO SET("",LINE,COLUMN,CLREND)
+8 QUIT
+9 ;
+10 ;
EXIT ; exit and clean up
+1 KILL ^TMP($JOB,"PRCPENLM")
+2 QUIT
+3 ;
+4 ;
DIQ(DR) ; diq call to retrieve data for dr fields
+1 NEW D0,DA,DIC,DIQ,DIQ2
+2 SET DA=PRCPINPT
SET DIQ(0)="E"
SET DIC="^PRCP(445,"
SET DIQ="PRCPDATA"
DO EN^DIQ1
+3 QUIT
+4 ;
+5 ;
SET(STRING,LINE,COLUMN,CLREND,FIELD,ON,OFF) ; set array
+1 IF $GET(FIELD)
SET STRING=STRING_": "_$GET(PRCPDATA(445,PRCPINPT,FIELD,"E"))
+2 IF STRING=""
DO SET^VALM10(LINE,$JUSTIFY("",80))
QUIT
+3 IF '$DATA(@VALMAR@(LINE,0))
DO SET^VALM10(LINE,$JUSTIFY("",80))
+4 DO SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND))
+5 IF $GET(ON)]""!($GET(OFF)]"")
DO CNTRL^VALM10(LINE,COLUMN,$LENGTH(STRING),ON,OFF)
+6 QUIT
+7 ;
+8 ;
ADDNEW ; this entry point is called from the option file from ifcap
+1 ; to set up new primary or warehouse inventory points
+2 IF '$GET(PRC("SITE"))
SET PRCF("X")="S"
DO ^PRCFSITE
+3 SET DIR(0)="SO^W:Warehouse;P:Primary"
SET DIR("A")="Select the type of inventory point to edit"
DO ^DIR
KILL DIR
IF Y'="W"
IF Y'="P"
QUIT
+4 SET PRCP("DPTYPE")=Y
+5 DO ENTERNEW
+6 KILL PRCP
+7 GOTO ADDNEW
