source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSER2.m@ 1504

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

initial load of WorldVistAEHR
File size: 3.1 KB
RevLine 
[613]1XUSER2 ;ISF/RWF - New Person File Utilities ;9:17 AM 9 Mar 2005
2 ;;8.0;KERNEL;**267,251,344**;Jul 10, 1995
3 Q
4VALDEA(X,F) ;Check for a valid DEA#
5 ;Returns 0 for NOT Valid, 1 for Valid
6 ;F = 1 for Facility DEA check.
7 I $D(X) K:$L(X)>9!($L(X)<9)!'(X?2U7N) X
8 S F=$G(F)
9 I $D(X),'F,$D(^VA(200,"PS1",X)),$O(^(X,0))'=DA D EN^DDIOL($C(7)_"CAN'T FILE: DUPLICATE DEA NUMBER") K X
10 I $D(X),'F,$D(DA),$E(X,2)'=$E($P(^VA(200,DA,0),"^")) D EN^DDIOL($C(7)_"WARNING: DEA# FORMAT MISMATCH -- CHECK SECOND LETTER")
11 I $D(X),'$$DEANUM(X) D EN^DDIOL($C(7)_"CAN'T FILE: DEA# FORMAT MISMATCH -- NUMERIC ALGORITHM FAILED") K X
12 Q $D(X)
13 ;
14DEANUM(X) ;Check DEA # part
15 N VA1,VA2
16 S VA1=$E(X,3)+$E(X,5)+$E(X,7)+(2*($E(X,4)+$E(X,6)+$E(X,8)))
17 S VA1=VA1#10,VA2=$E(X,9)
18 Q VA1=VA2
19 ;
20REQ(XUV,XUFLAG) ;Called from forms:
21 ; XUEXISTING USER, XUNEW USER, XUREACT USER, XU-CLINICAL TRAINEE
22 ;from the:
23 ; - Form-level pre-action
24 ; - Post action on change for "Is this person a Clinical Trainee?"
25 ;In:
26 ; XUV = 1 if user is a clinical trainee; 0 otherwise
27 ; If XUV is not passed, its value is obtained from the
28 ; CLINICAL CORE TRAINEE(#12.6).
29 ; XUFLAG = 1 if called from the XU-CLINICAL TRAINEE form;
30 ; otherwise, called from the other forms
31 ;
32 N BLOCK,PAGE,FIELD,F126
33 ; BLOCK = Block
34 ; PAGE = Page number
35 ; FIELD = Field number
36 I $G(XUFLAG) S BLOCK="XU-CLINICAL TRAINEE 1",PAGE=1
37 E D
38 . S BLOCK="XUEXISTING USER TRAINEE"
39 . S PAGE=5
40 ;
41 I $G(XUV)="" D ;Value not Passed get current value
42 . N ZERR
43 . S XUV=$$GET^DDSVAL(200,DA,"CLINICAL CORE TRAINEE",.ZERR,"I")
44 . S XUV=$S(XUV="N":0,XUV="":0,1:1)
45 S F126=XUV
46 ;
47 ;CURRENT DEGREE LEVEL 12.1
48 ;PROGRAM OF STUDY 12.2
49 ;LAST TRAINING MONTH & YEAR 12.3
50 ;VHA TRAINING FACILITY 12.4
51 ;DATE HL7 TRAINEE RECORD BUILT 12.5
52 ;CLINICAL CORE TRAINEE 12.6
53 ;DATE NO LONGER TRAINEE 12.7
54 ;START OF TRAINING 12.8
55 ;
56 I F126 D Q ;Logic for when field 12.6 equals YES or Null
57 . N FIELD
58 . ;Make fields required
59 . F FIELD="12.2F","12.4F" D REQ^DDSUTL(FIELD,BLOCK,PAGE,1)
60 . ;Delete value in field 12.7 & make it uneditable
61 . S FIELD=12.7 D PUT^DDSVAL(200,DA,FIELD,"@","","I")
62 . S FIELD="12.7F" D UNED^DDSUTL(FIELD,BLOCK,PAGE,1)
63 . D REQ^DDSUTL(FIELD,BLOCK,PAGE,0)
64 . ;Make the following fields editable
65 . F FIELD="12.1F","12.2F","12.3F","12.4F","12.8F" D UNED^DDSUTL(FIELD,BLOCK,PAGE,0)
66 . Q
67 I 'F126 D Q ;Logic for when field 12.6 equals NO
68 . N FIELD,ZERR,F122,F127
69 . S F122=$$GET^DDSVAL(200,DA,12.2,.ZERR,"I")
70 . S F127=$$GET^DDSVAL(200,DA,12.7,.ZERR,"I")
71 . I F122="" D Q ;Not a trainee, probably a mistake
72 .. ;Make fields not required
73 .. F FIELD="12.2F","12.4F" D REQ^DDSUTL(FIELD,BLOCK,PAGE,0)
74 .. ;Make field uneditable
75 .. F FIELD="12.1F","12.2F","12.3F","12.4F","12.7F","12.8F" D UNED^DDSUTL(FIELD,BLOCK,PAGE,1)
76 .. Q
77 . I F122]"",F127]"" Q
78 . ;Make fields not required
79 . F FIELD="12.2F","12.4F" D REQ^DDSUTL(FIELD,BLOCK,PAGE,0)
80 . ;Make the following field required & editable
81 . S FIELD="12.7F" D REQ^DDSUTL(FIELD,BLOCK,PAGE,1)
82 . S FIELD="12.7F" D UNED^DDSUTL(FIELD,BLOCK,PAGE,0)
83 . ;Don't allow editing of the following fields
84 . F FIELD="12.1F","12.2F","12.3F","12.4F","12.8F" D UNED^DDSUTL(FIELD,BLOCK,PAGE,1)
85 . Q
86 Q
Note: See TracBrowser for help on using the repository browser.