- 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 Feb 18, 2025@23:35:28 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