- 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 Mar 13, 2025@21:16:20 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
