source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPCUDI.m@ 1582

Last change on this file since 1582 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1PRCPCUDI ;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 ;
7CHECK(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 ;
32KILL ; kill x and dinum
33 K X,DINUM
34 Q
Note: See TracBrowser for help on using the repository browser.