PRCHNPT.m

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 ---PRCHNPT   1429     printed  Apr 09, 2024@21:17:49                                                                                                                                                                                                     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