| [613] | 1 | PRCPCUDI ;WISC/RFJ-fileman input transforms for case carts ;01 Sep 93
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | CHECK(FILE,FIELD) ; check input transform for files 445.7 and 445.8
|
|---|
| 8 | ; x = item master number
|
|---|
| 9 | ; if it fails goto kill and kill x and dinum
|
|---|
| 10 | N MESSAGE
|
|---|
| 11 | S MESSAGE="UNAUTHORIZED ACCESS"
|
|---|
| 12 | I '$G(PRCPPRIV) D KILL Q MESSAGE
|
|---|
| 13 | S MESSAGE=""
|
|---|
| 14 | I FILE=445.7,FIELD=.01 D Q MESSAGE
|
|---|
| 15 | . I $$PURCHASE^PRCPU441(X) S MESSAGE="*** Item cannot be defined as 'purchasable' in item master file ***" D KILL Q
|
|---|
| 16 | . I $D(^PRCP(445.8,X,0)) S MESSAGE="*** Item is already defined as an Instrument Kit ***" D KILL Q
|
|---|
| 17 | . I $D(^PRCP(445.8,"AI",X)) S MESSAGE="*** Item is included in an Instrument Kit ***" D KILL Q
|
|---|
| 18 | ;
|
|---|
| 19 | I FILE=445.7,FIELD=1 D Q MESSAGE
|
|---|
| 20 | . I $D(^PRCP(445.7,"B",X)) S MESSAGE="*** A Case Cart cannot be an item in a Case Cart ***" D KILL Q
|
|---|
| 21 | ;
|
|---|
| 22 | I FILE=445.8,FIELD=.01 D Q MESSAGE
|
|---|
| 23 | . I $$PURCHASE^PRCPU441(X) S MESSAGE="*** Item cannot be defined as 'purchasable' in item master file ***" D KILL Q
|
|---|
| 24 | . I $D(^PRCP(445.7,X,0)) S MESSAGE="*** Item is already defined as a Case Cart ***" D KILL Q
|
|---|
| 25 | ;
|
|---|
| 26 | I FILE=445.8,FIELD=1 D Q MESSAGE
|
|---|
| 27 | . I $D(^PRCP(445.8,X,0)) S MESSAGE="*** Item is already defined as an Instrument Kit ***" D KILL Q
|
|---|
| 28 | . I $D(^PRCP(445.7,X,0)) S MESSAGE="*** Item is already defined as a Case Cart ***" D KILL Q
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | ;
|
|---|
| 32 | KILL ; kill x and dinum
|
|---|
| 33 | K X,DINUM
|
|---|
| 34 | Q
|
|---|
