PRCPE441.m

PRCPE441 ;WISC/RFJ-enter edit master item file                      ;10 Dec 91

 ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 D ^PRCPUSEL Q:'$G(PRCP("I"))

 I $P($G(^PRCP(445,PRCP("I"),0)),"^",20)'="S" K X S X(1)="ONLY 'SPD' INVENTORY POINTS MAY ACCESS THIS OPTION SINCE THE FIELDS EDITABLE UNDER THIS OPTION ONLY PERTAIN TO CASE CARTS AND INSTRUMENT KITS." Q

 I '$$KEY^PRCPUREP("PRCP"_$TR(PRCP("DPTYPE"),"WSP","W2")_" MGRKEY",DUZ) W !,"YOU MUST BE AN INVENTORY MANAGER BEFORE YOU CAN USE THIS OPTION." Q

 N %,D0,DA,DI,DIC,DIE,DQ,DR,ITEMDA,X,Y

 K X S X(1)="Only items stored in the "_PRCP("IN")_" are selectable." W ! D DISPLAY^PRCPUX2(1,40,.X)

 F  S ITEMDA=$$MASTITEM^PRCPUITM("I $D(^PRCP(445,PRCP(""I""),1,+Y,0))") Q:'ITEMDA  D  W !

 .   S (DIC,DIE)="^PRC(441,",DA=ITEMDA,DR=".06" D ^DIE

 .   S DR=$S($P($G(^PRC(441,ITEMDA,0)),"^",6)="S":"23///@",1:23) D ^DIE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCPE441   925     printed  Apr 23, 2025@18:28                                                                                                                                                                                                        Page 2

PRCPE441  ;WISC/RFJ-enter edit master item file                      ;10 Dec 91

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        DO ^PRCPUSEL

           if '$GET(PRCP("I"))

               QUIT 

 +4        IF $PIECE($GET(^PRCP(445,PRCP("I"),0)),"^",20)'="S"

               KILL X

               SET X(1)="ONLY 'SPD' INVENTORY POINTS MAY ACCESS THIS OPTION SINCE THE FIELDS EDITABLE UNDER THIS OPTION ONLY PERTAIN TO CASE CARTS AND INSTRUMENT KITS."

               QUIT 

 +5        IF '$$KEY^PRCPUREP("PRCP"_$TRANSLATE(PRCP("DPTYPE"),"WSP","W2")_" MGRKEY",DUZ)

               WRITE !,"YOU MUST BE AN INVENTORY MANAGER BEFORE YOU CAN USE THIS OPTION."

               QUIT 

 +6        NEW %,D0,DA,DI,DIC,DIE,DQ,DR,ITEMDA,X,Y

 +7        KILL X

           SET X(1)="Only items stored in the "_PRCP("IN")_" are selectable."

           WRITE !

           DO DISPLAY^PRCPUX2(1,40,.X)

 +8        FOR 

               SET ITEMDA=$$MASTITEM^PRCPUITM("I $D(^PRCP(445,PRCP(""I""),1,+Y,0))")

               if 'ITEMDA

                   QUIT 

               Begin DoDot:1

 +9                SET (DIC,DIE)="^PRC(441,"

                   SET DA=ITEMDA

                   SET DR=".06"

                   DO ^DIE

 +10               SET DR=$SELECT($PIECE($GET(^PRC(441,ITEMDA,0)),"^",6)="S":"23///@",1:23)

                   DO ^DIE

               End DoDot:1

               WRITE !

 +11       QUIT