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 ---[H[J[2J[HPRCIREC1 758 printed Dec 13, 2024@02:11:33 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
