source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL14.m@ 668

Last change on this file since 668 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1RAUTL14 ;HISC/GJC-Utilities for message display. ;10/19/94 08:53
2 ;;5.0;Radiology/Nuclear Medicine;**34**;Mar 16, 1998
3EN1 ; Message display. Called from the input transform of the
4 ;'TYPE OF IMAGING' field of the Imaging Locations file
5 ; i.e, ^DD(79.1,6,0) --> D:'$D(^RA(79.1,"BIMG",+Y)) EN1^RAUTL14
6 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RATXT,RAX,RAY,RAYN
7 S RAX=X,RAY=Y,RATXT(1)=" " K X,Y
8 S RATXT(2)="** Caution: You are activating a new Imaging Type. **"
9 S RATXT(3)=" This means you will have to assign procedures to"
10 S RATXT(4)=" this imaging type. Workload reports will be printed"
11 S RATXT(5)=" separately for this Imaging Type."
12 S RATXT(6)=" " D EN^DDIOL(.RATXT) S DIR(0)="YA"
13 S DIR("A")="Are you sure? "
14 S DIR("?")="Enter 'Y' for yes, 'N' to re-edit this field."
15 D ^DIR S RAYN=+Y K X,Y D EN^DDIOL(" ")
16 S X=RAX,Y=RAY K:'RAYN X Q:'$D(X)
17 I $D(^RA(79.2,"B","CARDIOLOGY STUDIES (NUC MED)",+Y)) K RATXT D
18 . S RATXT(1)=" The 'CARDIOLOGY STUDIES' imaging type should not be"
19 . S RATXT(2)=" activated unless nuclear cardiology is done separately"
20 . S RATXT(3)=" from Nuclear Medicine at your facility."
21 . D EN^DDIOL(.RATXT)
22 . Q
23 Q
24EN2 ; Message display. Called from input transform of the
25 ;'TYPE OF IMAGING' field of the Rad/Nuc Med Procedure file
26 ; i.e, ^DD(71,12,0) --> D EN2^RAUTL14
27 I '$D(^RA(79.1,"BIMG",+Y)) D
28 . N RATXT,X,Y S RATXT(1)=" "
29 . S RATXT(2)="This Imaging Type has not been assigned to any Imaging Location."
30 . S RATXT(3)="In order to register this procedure for patients, you must"
31 . S RATXT(4)="assign this Imaging Type to an Imaging Location."
32 . S RATXT(5)=" " D EN^DDIOL(.RATXT)
33 . Q
34 N RAD0,RASEQ
35 S RAD0=+$O(^RAMIS(71.3,"B",D0,0)),RASEQ=$P($G(^RAMIS(71.3,RAD0,0)),U,4)
36 I RASEQ D K X
37 . N RATXT,X,Y S RATXT(1)=" "
38 . S RATXT(2)="This procedure was found in the Rad/Nuc Med Common"
39 . S RATXT(3)="Procedure file. To change its imaging type you must"
40 . S RATXT(4)="first inactivate it in that file. After it is made"
41 . S RATXT(5)="inactive you may change its imaging type. You can"
42 . S RATXT(6)="then reactivate it if you wish."
43 . S RATXT(7)=" " D EN^DDIOL(.RATXT)
44 . Q
45 Q
46UNI30(RADA,RAX) ; Determines if the 1st 30 chars of a procedure name are unique.
47 ; If not, do not allow the user to add or alter the current procedure.
48 ; Don't allow characters ; ^
49 ; Called from the input transform in ^DD(71,.01,0)
50 ; Pass back 1 if unique, 0 if a conflict.
51 ; 'RA' ---> temporary variable to hold data
52 ; 'RAX' ---> Input user wishes to enter/edit in ^RAMIS(71
53 ; 'RADA' ---> IEN of the current entry in ^RAMIS(71,
54 ; The first 30 do not match any other entries first 30
55 N RA1,RA2,RABEG,RAEND,RAFLG1,RAFLG2,RALEN,RALST,RAPCE,RAY,RAI,RAQ
56 S (RAFLG1,RAFLG2)=0
57 ;S RABEG=$E(RAX,1,30),RALEN=$L(RABEG),RALST=$E(RABEG,$L(RABEG))
58 ;S RAEND=$E(RABEG,1,(RALEN-1))_$C(($A(RALST)-1))_"z"
59 ;
60 ; Check for bad chars
61 S RAY=";^",RAQ=""
62 F RAI=1:1:$L(RAY) I RAX[($E(RAY,RAI)) S RAQ=1
63 I RAQ D EN^DDIOL("Entry must not contain ^ or ; ",,"!?12,$C(7)") Q 0 ; bad char detected, so reject entry
64 ;
65 ;
66 S RA1=$O(^RAMIS(71,"B",RAX),-1) ; Obtain collating entry immediately
67 ; before user input. Check 1st 30 of prior
68 ; entry aginst 1st 30 of user entry.
69 ; If different, ok!
70 ;
71 S:$E(RA1,1,30)'=$E(RAX,1,30) RAFLG1=1
72 ;
73 S RA2=$O(^RAMIS(71,"B",RAX)) ; Obtain the collating entry of
74 S:$E(RA2,1,30)'=$E(RAX,1,30) RAFLG2=1 ; the entry immediately after the
75 ; user input. If the 1st 30 of
76 ; user input does not equal the
77 ; 1st 30 of the next collating
78 ; entry, the input is ok!
79 ;
80 ; Brand new entry
81 I RADA=0 Q $S((RAFLG1+RAFLG2)>1:1,1:0)
82 ;
83 S RAPCE=$P($G(^RAMIS(71,RADA,0)),"^")
84 I RADA,($E(RAPCE,1,30)=$E(RAX,1,30)) Q 1 ; 1st 30 chars of user input
85 ; may equal the 1st 30 chars
86 ; of the record we are editing.
87 ;
88 E Q $S((RAFLG1+RAFLG2)>1:1,1:0) ; The 1st thirty chars may have changed
89 ; Check RAFLG1 & RAFLG2 for conflicts
90 ; with any other data in the database.
Note: See TracBrowser for help on using the repository browser.