PRCIREC1.m

PRCIREC1 ;WISC/SWS-Filed transform code ;9/7/06  14:22

V ;;5.1;IFCAP;**107**;Oct 20, 2000;Build 13

 ;Per VHA Directive 2004-038, this routine should not be modified.

 ;This routine serves as the input transform for the field Inventory Point in File ^PRCP(445)

 Q

START S:X'["-" X=$G(PRC("SITE"))_"-"_X

 I 'X!($L(X)>30)!(X'?3N1"-"1ANP.ANP)!('$G(PRCPPRIV)) K X Q

 I +X'=PRC("SITE") D

 . K MSG

 .S MSG(1)="  "_+X_" not current station number."

 .D EN^DDIOL(.MSG)

 .K MSG,X

 I $D(X),$O(^PRCP(445,"B",X,0)) D

 . S MSG(1)="  DUPLICATE NAME"

 . D EN^DDIOL(.MSG)

 . K MSG,X

 Q

DELETE I $P($G(^PRCP(445,D0,0)),U,3)="W" D

 . K MSG

 . S MSG(1)="YOU CANNOT DELETE WAREHOUSE TYPE INVENTORY POINTS.",MSG(1,"F")="!?2"

 . D EN^DDIOL(.MSG)

 . K MSG

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCIREC1   758     printed  Sep 02, 2024@18:56:51                                                                                                                                                                                                     Page 2

PRCIREC1  ;WISC/SWS-Filed transform code ;9/7/06  14:22

V         ;;5.1;IFCAP;**107**;Oct 20, 2000;Build 13

 +1       ;Per VHA Directive 2004-038, this routine should not be modified.

 +2       ;This routine serves as the input transform for the field Inventory Point in File ^PRCP(445)

 +3        QUIT 

START      if X'["-"

               SET X=$GET(PRC("SITE"))_"-"_X

 +1        IF 'X!($LENGTH(X)>30)!(X'?3N1"-"1ANP.ANP)!('$GET(PRCPPRIV))

               KILL X

               QUIT 

 +2        IF +X'=PRC("SITE")

               Begin DoDot:1

 +3                KILL MSG

 +4                SET MSG(1)="  "_+X_" not current station number."

 +5                DO EN^DDIOL(.MSG)

 +6                KILL MSG,X

               End DoDot:1

 +7        IF $DATA(X)

               IF $ORDER(^PRCP(445,"B",X,0))

                   Begin DoDot:1

 +8                    SET MSG(1)="  DUPLICATE NAME"

 +9                    DO EN^DDIOL(.MSG)

 +10                   KILL MSG,X

                   End DoDot:1

 +11       QUIT 

DELETE     IF $PIECE($GET(^PRCP(445,D0,0)),U,3)="W"

               Begin DoDot:1

 +1                KILL MSG

 +2                SET MSG(1)="YOU CANNOT DELETE WAREHOUSE TYPE INVENTORY POINTS."

                   SET MSG(1,"F")="!?2"

 +3                DO EN^DDIOL(.MSG)

 +4                KILL MSG

               End DoDot:1

 +5        QUIT