PRCHNPT ;SF/TKW-INPUT TRANSFORM ;11/23/16 13:26
V ;;5.1;IFCAP;**108,198**;Oct 20, 2000;Build 6
;Per VA Directive 6402, this routine should not be modified.
EN1 ;INPUT TRANSFORM FOR NSN (FIELD #5) ON ITEM MASTER FILE (441)
Q:'$D(X) I '$D(^PRC(441.2,+X,0)) D EN^DDIOL("First 4 digits MUST be an FSC code!!","","!") K X Q
S Z=$O(^PRC(441,"BB",X,0)) S:Z=DA Z=$O(^(DA)) I Z D EN^DDIOL("This NSN has already been assigned to Item # "_Z_"!!","","!") K X,Z Q
K Z Q
; --------------------
; *108 - additional Input Transform code and Executable Help code added 4/6/2007 by T. Holloway
;
CONTRACT(PRCDA1,PRCINPUT) ; 443.6 : 443.61 : 4 - CONTRACT/BOA # Input Transform
; PRCDA1 = the IEN for file 443.6 passed in from the DA(1) variable.
; PRCINPUT = the user input passed in from the X variable
N D,DA,DIC,DR,X
S X=PRCINPUT
S DA(1)=+$P(^PRC(443.6,PRCDA1,1),U)
S DIC="^PRC(440,DA(1),4,",DIC(0)="QELM"
D ^DIC K DIC
Q Y
;
HLPCON(PRCDA1,PRCINPUT) ; 443.6 : 443.61 : 4 - CONTRACT/BOA # Executable Help
; PRCDA1 = the IEN for file 443.6 passed in from the DA(1) variable.
; PRCINPUT = the user input passed in from the X variable, will be some form of ?.
N D,DA,DIC,DR,X,Y,Z1
S X=PRCINPUT
S DA(1)=+$P(^PRC(443.6,PRCDA1,1),U),Z1=$P(^(1),U,7)
I '$D(^PRC(440,DA(1),4,0)) Q
S DIC("S")=$S(Z1=2:"I $P(^PRC(440,DA(1),4,+Y,0),U,6)'=""B""",1:"I 1")
S DIC="^PRC(440,DA(1),4,",DIC(0)="QEM" D ^DIC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHNPT 1429 printed Dec 13, 2024@02:09:05 Page 2
PRCHNPT ;SF/TKW-INPUT TRANSFORM ;11/23/16 13:26
V ;;5.1;IFCAP;**108,198**;Oct 20, 2000;Build 6
+1 ;Per VA Directive 6402, this routine should not be modified.
EN1 ;INPUT TRANSFORM FOR NSN (FIELD #5) ON ITEM MASTER FILE (441)
+1 if '$DATA(X)
QUIT
IF '$DATA(^PRC(441.2,+X,0))
DO EN^DDIOL("First 4 digits MUST be an FSC code!!","","!")
KILL X
QUIT
+2 SET Z=$ORDER(^PRC(441,"BB",X,0))
if Z=DA
SET Z=$ORDER(^(DA))
IF Z
DO EN^DDIOL("This NSN has already been assigned to Item # "_Z_"!!","","!")
KILL X,Z
QUIT
+3 KILL Z
QUIT
+4 ; --------------------
+5 ; *108 - additional Input Transform code and Executable Help code added 4/6/2007 by T. Holloway
+6 ;
CONTRACT(PRCDA1,PRCINPUT) ; 443.6 : 443.61 : 4 - CONTRACT/BOA # Input Transform
+1 ; PRCDA1 = the IEN for file 443.6 passed in from the DA(1) variable.
+2 ; PRCINPUT = the user input passed in from the X variable
+3 NEW D,DA,DIC,DR,X
+4 SET X=PRCINPUT
+5 SET DA(1)=+$PIECE(^PRC(443.6,PRCDA1,1),U)
+6 SET DIC="^PRC(440,DA(1),4,"
SET DIC(0)="QELM"
+7 DO ^DIC
KILL DIC
+8 QUIT Y
+9 ;
HLPCON(PRCDA1,PRCINPUT) ; 443.6 : 443.61 : 4 - CONTRACT/BOA # Executable Help
+1 ; PRCDA1 = the IEN for file 443.6 passed in from the DA(1) variable.
+2 ; PRCINPUT = the user input passed in from the X variable, will be some form of ?.
+3 NEW D,DA,DIC,DR,X,Y,Z1
+4 SET X=PRCINPUT
+5 SET DA(1)=+$PIECE(^PRC(443.6,PRCDA1,1),U)
SET Z1=$PIECE(^(1),U,7)
+6 IF '$DATA(^PRC(440,DA(1),4,0))
QUIT
+7 SET DIC("S")=$SELECT(Z1=2:"I $P(^PRC(440,DA(1),4,+Y,0),U,6)'=""B""",1:"I 1")
+8 SET DIC="^PRC(440,DA(1),4,"
SET DIC(0)="QEM"
DO ^DIC
+9 QUIT
