TIUABBV ;BPOIFO/EL - Input transforms for UNAUTHORIZED ABBREVIATIONS ;7/10/2015
;;1.0;TEXT INTEGRATION UTILITIES;**297**;JUN 20, 1997;Build 40
;
; External Reference DBIA#:
; -------------------------
; #10142 - DDIOL call (Supported)
; #10104 - XLFSTR call (Supported)
;
Q
;
LABBV(X) ; LOCAL Unauthorized Abbreviation check
; Check and prevent National Abbreviation to be edited
I $P($G(^TIU(8927.9,+$G(DA),0)),U,2)="N" D Q 0
. D EN^DDIOL("National Unauthorized Abbreviation cannot be altered.")
;
CKABBV ;NATIONAL AND LOCAL Unauthorized Abbreviation check
I $L(X)>30!($L(X)<1) D Q 0
. D EN^DDIOL("Abbreviation has to be within 1 to 30 character(s)")
I $F(X,"|")!$F(X,"^")!$F(X,"&")!$F(X,"~")!$F(X,"\") D Q 0
. D EN^DDIOL("Abbreviation cannot contain the following punctuations: |^&~\:;,!?")
I $F(X,":")!$F(X,";")!$F(X,",")!$F(X,"!")!$F(X,"?") D Q 0
. D EN^DDIOL("Abbreviation cannot contain the following punctuations: |^&~\:;,!?")
I $F(X," ") D Q 0
. D EN^DDIOL("Abbreviation has to be one word without space.")
I $L(X)=1,$A($$UP^XLFSTR(X))<65!($A($$UP^XLFSTR(X))>90) D Q 0
. D EN^DDIOL("Abbreviation cannot be one non-alpha character.")
I X?1P.P D Q 0
. D EN^DDIOL("Abbreviation cannot contain all punctuations.")
I ($G(Y)="-1"),'$D(^TIU(8927.9,"B",$G(X))) G SETABBV ;Q 1
I $G(Y)=$G(X),($G(X)'="") G SETABBV ;Q 1
I '$D(^TIU(8927.9,"B",$G(X))) G SETABBV ;Q 1
I +$G(DA)>0,($G(^TIU(8927.9,+$G(DA),0),U)'=""),($G(Y)'=$G(X)) D Q 0
. D EN^DDIOL("Unauthorized Abbreviation cannot be modified once created but allows to inactivate STATUS.")
I ($G(Y)'=$G(X)),$D(^TIU(8927.9,"B",$G(X))) D G SETABBV
. D EN^DDIOL("The abbreviation "_X_" already exists.")
SETABBV ;
S X=""""_X_""""
Q 1
;
ABBV(X) ;NATIONAL ABBREVIATIONS check
G CKABBV
;
;
CLASS(X) ;NATIONAL ABBREVIATIONS CLASS check
I ($P($G(^TIU(8927.9,+$G(DA),0)),U,2))=$G(X) Q 1
I (DUZ(0)="@"),(X="N") Q 1
I (DUZ(0)'="@"),(X="N") D Q 0
. D EN^DDIOL("You are not allowed to create NATIONAL Class.")
G CKCLASS
;
;
LCLASS(X) ;LOCAL ABBREVIATIONS CLASS check
I ($P($G(^TIU(8927.9,+$G(DA),0)),U,2)="N"),(X'="N") D Q 0
. D EN^DDIOL("National Abbreviation Class cannot be altered.")
CKCLASS ;
I ($P($G(^TIU(8927.9,+$G(DA),0)),U,2))=$G(X) Q 1
I (X'="L") D Q 0
. D EN^DDIOL("Local site can only create LOCAL Class.")
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUABBV 2393 printed Nov 22, 2024@17:48:38 Page 2
TIUABBV ;BPOIFO/EL - Input transforms for UNAUTHORIZED ABBREVIATIONS ;7/10/2015
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**297**;JUN 20, 1997;Build 40
+2 ;
+3 ; External Reference DBIA#:
+4 ; -------------------------
+5 ; #10142 - DDIOL call (Supported)
+6 ; #10104 - XLFSTR call (Supported)
+7 ;
+8 QUIT
+9 ;
LABBV(X) ; LOCAL Unauthorized Abbreviation check
+1 ; Check and prevent National Abbreviation to be edited
+2 IF $PIECE($GET(^TIU(8927.9,+$GET(DA),0)),U,2)="N"
Begin DoDot:1
+3 DO EN^DDIOL("National Unauthorized Abbreviation cannot be altered.")
End DoDot:1
QUIT 0
+4 ;
CKABBV ;NATIONAL AND LOCAL Unauthorized Abbreviation check
+1 IF $LENGTH(X)>30!($LENGTH(X)<1)
Begin DoDot:1
+2 DO EN^DDIOL("Abbreviation has to be within 1 to 30 character(s)")
End DoDot:1
QUIT 0
+3 IF $FIND(X,"|")!$FIND(X,"^")!$FIND(X,"&")!$FIND(X,"~")!$FIND(X,"\")
Begin DoDot:1
+4 DO EN^DDIOL("Abbreviation cannot contain the following punctuations: |^&~\:;,!?")
End DoDot:1
QUIT 0
+5 IF $FIND(X,":")!$FIND(X,";")!$FIND(X,",")!$FIND(X,"!")!$FIND(X,"?")
Begin DoDot:1
+6 DO EN^DDIOL("Abbreviation cannot contain the following punctuations: |^&~\:;,!?")
End DoDot:1
QUIT 0
+7 IF $FIND(X," ")
Begin DoDot:1
+8 DO EN^DDIOL("Abbreviation has to be one word without space.")
End DoDot:1
QUIT 0
+9 IF $LENGTH(X)=1
IF $ASCII($$UP^XLFSTR(X))<65!($ASCII($$UP^XLFSTR(X))>90)
Begin DoDot:1
+10 DO EN^DDIOL("Abbreviation cannot be one non-alpha character.")
End DoDot:1
QUIT 0
+11 IF X?1P.P
Begin DoDot:1
+12 DO EN^DDIOL("Abbreviation cannot contain all punctuations.")
End DoDot:1
QUIT 0
+13 ;Q 1
IF ($GET(Y)="-1")
IF '$DATA(^TIU(8927.9,"B",$GET(X)))
GOTO SETABBV
+14 ;Q 1
IF $GET(Y)=$GET(X)
IF ($GET(X)'="")
GOTO SETABBV
+15 ;Q 1
IF '$DATA(^TIU(8927.9,"B",$GET(X)))
GOTO SETABBV
+16 IF +$GET(DA)>0
IF ($GET(^TIU(8927.9,+$GET(DA),0),U)'="")
IF ($GET(Y)'=$GET(X))
Begin DoDot:1
+17 DO EN^DDIOL("Unauthorized Abbreviation cannot be modified once created but allows to inactivate STATUS.")
End DoDot:1
QUIT 0
+18 IF ($GET(Y)'=$GET(X))
IF $DATA(^TIU(8927.9,"B",$GET(X)))
Begin DoDot:1
+19 DO EN^DDIOL("The abbreviation "_X_" already exists.")
End DoDot:1
GOTO SETABBV
SETABBV ;
+1 SET X=""""_X_""""
+2 QUIT 1
+3 ;
ABBV(X) ;NATIONAL ABBREVIATIONS check
+1 GOTO CKABBV
+2 ;
+3 ;
CLASS(X) ;NATIONAL ABBREVIATIONS CLASS check
+1 IF ($PIECE($GET(^TIU(8927.9,+$GET(DA),0)),U,2))=$GET(X)
QUIT 1
+2 IF (DUZ(0)="@")
IF (X="N")
QUIT 1
+3 IF (DUZ(0)'="@")
IF (X="N")
Begin DoDot:1
+4 DO EN^DDIOL("You are not allowed to create NATIONAL Class.")
End DoDot:1
QUIT 0
+5 GOTO CKCLASS
+6 ;
+7 ;
LCLASS(X) ;LOCAL ABBREVIATIONS CLASS check
+1 IF ($PIECE($GET(^TIU(8927.9,+$GET(DA),0)),U,2)="N")
IF (X'="N")
Begin DoDot:1
+2 DO EN^DDIOL("National Abbreviation Class cannot be altered.")
End DoDot:1
QUIT 0
CKCLASS ;
+1 IF ($PIECE($GET(^TIU(8927.9,+$GET(DA),0)),U,2))=$GET(X)
QUIT 1
+2 IF (X'="L")
Begin DoDot:1
+3 DO EN^DDIOL("Local site can only create LOCAL Class.")
End DoDot:1
QUIT 0
+4 QUIT 1
+5 ;
