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 Dec 13, 2024@02:13:21 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
