PRCPCUDI.m

PRCPCUDI ;WISC/RFJ-fileman input transforms for case carts          ;01 Sep 93

 ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

 ;

CHECK(FILE,FIELD) ;  check input transform for files 445.7 and 445.8

 ;  x = item master number

 ;  if it fails goto kill and kill x and dinum

 N MESSAGE

 S MESSAGE="UNAUTHORIZED ACCESS"

 I '$G(PRCPPRIV) D KILL Q MESSAGE

 S MESSAGE=""

 I FILE=445.7,FIELD=.01 D  Q MESSAGE

 .   I $$PURCHASE^PRCPU441(X) S MESSAGE="*** Item cannot be defined as 'purchasable' in item master file ***" D KILL Q

 .   I $D(^PRCP(445.8,X,0)) S MESSAGE="*** Item is already defined as an Instrument Kit ***" D KILL Q

 .   I $D(^PRCP(445.8,"AI",X)) S MESSAGE="*** Item is included in an Instrument Kit ***" D KILL Q

 ;

 I FILE=445.7,FIELD=1 D  Q MESSAGE

 .   I $D(^PRCP(445.7,"B",X)) S MESSAGE="*** A Case Cart cannot be an item in a Case Cart ***" D KILL Q

 ;

 I FILE=445.8,FIELD=.01 D  Q MESSAGE

 .   I $$PURCHASE^PRCPU441(X) S MESSAGE="*** Item cannot be defined as 'purchasable' in item master file ***" D KILL Q

 .   I $D(^PRCP(445.7,X,0)) S MESSAGE="*** Item is already defined as a Case Cart ***" D KILL Q

 ;

 I FILE=445.8,FIELD=1 D  Q MESSAGE

 .   I $D(^PRCP(445.8,X,0)) S MESSAGE="*** Item is already defined as an Instrument Kit ***" D KILL Q

 .   I $D(^PRCP(445.7,X,0)) S MESSAGE="*** Item is already defined as a Case Cart ***" D KILL Q

 Q

 ;

 ;

KILL ;  kill x and dinum

 K X,DINUM

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCPCUDI   1489     printed  Apr 09, 2024@21:08:15                                                                                                                                                                                                    Page 2

PRCPCUDI  ;WISC/RFJ-fileman input transforms for case carts          ;01 Sep 93

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

 +5       ;

CHECK(FILE,FIELD) ;  check input transform for files 445.7 and 445.8

 +1       ;  x = item master number

 +2       ;  if it fails goto kill and kill x and dinum

 +3        NEW MESSAGE

 +4        SET MESSAGE="UNAUTHORIZED ACCESS"

 +5        IF '$GET(PRCPPRIV)

               DO KILL

               QUIT MESSAGE

 +6        SET MESSAGE=""

 +7        IF FILE=445.7

               IF FIELD=.01

                   Begin DoDot:1

 +8                    IF $$PURCHASE^PRCPU441(X)

                           SET MESSAGE="*** Item cannot be defined as 'purchasable' in item master file ***"

                           DO KILL

                           QUIT 

 +9                    IF $DATA(^PRCP(445.8,X,0))

                           SET MESSAGE="*** Item is already defined as an Instrument Kit ***"

                           DO KILL

                           QUIT 

 +10                   IF $DATA(^PRCP(445.8,"AI",X))

                           SET MESSAGE="*** Item is included in an Instrument Kit ***"

                           DO KILL

                           QUIT 

                   End DoDot:1

                   QUIT MESSAGE

 +11      ;

 +12       IF FILE=445.7

               IF FIELD=1

                   Begin DoDot:1

 +13                   IF $DATA(^PRCP(445.7,"B",X))

                           SET MESSAGE="*** A Case Cart cannot be an item in a Case Cart ***"

                           DO KILL

                           QUIT 

                   End DoDot:1

                   QUIT MESSAGE

 +14      ;

 +15       IF FILE=445.8

               IF FIELD=.01

                   Begin DoDot:1

 +16                   IF $$PURCHASE^PRCPU441(X)

                           SET MESSAGE="*** Item cannot be defined as 'purchasable' in item master file ***"

                           DO KILL

                           QUIT 

 +17                   IF $DATA(^PRCP(445.7,X,0))

                           SET MESSAGE="*** Item is already defined as a Case Cart ***"

                           DO KILL

                           QUIT 

                   End DoDot:1

                   QUIT MESSAGE

 +18      ;

 +19       IF FILE=445.8

               IF FIELD=1

                   Begin DoDot:1

 +20                   IF $DATA(^PRCP(445.8,X,0))

                           SET MESSAGE="*** Item is already defined as an Instrument Kit ***"

                           DO KILL

                           QUIT 

 +21                   IF $DATA(^PRCP(445.7,X,0))

                           SET MESSAGE="*** Item is already defined as a Case Cart ***"

                           DO KILL

                           QUIT 

                   End DoDot:1

                   QUIT MESSAGE

 +22       QUIT 

 +23      ;

 +24      ;

KILL      ;  kill x and dinum

 +1        KILL X,DINUM

 +2        QUIT