- 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 ---[H[J[2J[HPRCPCUDI 1489 printed Apr 23, 2025@18:27:52 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
