Routine: PRCPENLM

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)

HDR ;  build header

 S VALMHDR(1)="INVENTORY POINT: "_$$INVNAME^PRCPUX1(PRCPINPT)_"    TOTAL NUMBER OF ITEMS: "_+$P($G(^PRCP(445,PRCPINPT,1,0)),"^",4)

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

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)

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)

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)

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)

EXIT ;  exit and clean up

 K ^TMP($J,"PRCPENLM")

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

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)

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 23, 2025@18:28:18                                                                                                                                                                                                    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

PRCPENLM.m