source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCPR1.m@ 1500

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1SCMCPR1 ;ALB/SCK - API FILE FOR STAFF ASSIGNMENTS ; 9/14/05 12:10pm
2 ;;5.3;Scheduling;**41,45,264,297**;AUG 13, 1993
3 ;;1.0
4 Q
5 ;
6URSLKUP(SCDAT,SCUSR,SCVAL,SCREEN,SCINST,SCPC) ;
7 ; Does a lookup in the USR #8930.3 file based on the user class match passed in
8 ;
9 ; Input
10 ; SCUSR User class to use for lookup
11 ; SCVAL Partial User name to lookup on
12 ;
13 ; Returns an array of matches found, or an error array.
14 ; Format for array:
15 ; SCDATA(1)=[Data]
16 ; SCDATA(x)=IEN^New Users Name^Title
17 ;
18 ; Format for Error:
19 ; SCDATA(1)=[Errors]
20 ; SCDATA(x)=" message "
21 ;
22 N SCI,N,SCRTN,SCTMP,SCTITLE,SCIEN,SCN,SCUERR
23 ;
24 I SCUSR']""&(SCINST=1) D G USRQ
25 . S N=0
26 . D SETF("[Errors]")
27 . D SETF("No User Class Defined")
28 ;
29 IF $L(SCVAL)<3&(SCINST=0) D G USRQ
30 . S N=0
31 .D SETF("[Errors]")
32 .D SETF("Insufficient characters to match")
33 ;
34 S N=0
35 IF SCINST=1 D
36 . D LIST^DIC(200,"",".01;8;28","","","",SCVAL,"","IF $$ISA^USRLM(Y,SCUSR,.SCUERR)","","")
37 ;
38 IF SCINST=0 D
39 .D LIST^DIC(200,"",".01;8;28","","","",SCVAL,"",SCREEN,"","")
40 ;
41 S N=0
42 D SETF("[Data]")
43 S I="" F S I=$O(^TMP("DILIST",$J,1,I)) Q:'I D
44 . S SCTMP=^TMP("DILIST",$J,2,I)_U
45 . I $G(SCPC) I $O(^SD(403.46,+SCPC,2,0)) N PC S PC=0 D Q:'PC ;Put back for provider by role
46 .. N CODE S CODE=$$GET^XUA4A72(+SCTMP) D Q:PC
47 ... I $D(^SD(403.46,+SCPC,2,+CODE)) S PC=1
48 . S:SCINST SCTMP=SCTMP_$$CLNAME^USRLM(+SCUSR)
49 . S SCTMP=SCTMP_U_U_U_U_^TMP("DILIST",$J,1,I)
50 . S SCTMP=SCTMP_U_^TMP("DILIST",$J,"ID",I,8)
51 . S SCTMP=SCTMP_U_^TMP("DILIST",$J,"ID",I,28)
52 . D SETF(SCTMP)
53 ;
54 K ^TMP("DILIST",$J)
55USRQ Q
56 ;
57SETF(X) ;
58 S N=N+1
59 S SCDAT(N)=X
60 Q
61 ;
62 ;
63TEST(CHK) ;
64 N SC,SCCHECK
65 K SCK
66 IF CHK=1 D
67 . S DIC="^USR(8930,",DIC("A")="Enter User Class: ",DIC(0)="AEMZ"
68 . D ^DIC
69 . W !,Y,!
70 . R "Lookup: ",X:60
71 . Q:'$G(Y)>0
72 . D URSLKUP(.SCK,$P(Y,U),X,"",CHK)
73 ;
74 IF CHK=0 D
75 . R "Name: ",X:60
76 . D URSLKUP(.SCK,"",X,"",CHK)
77 ;
78 ;;;W ! ZW SCK
79TESTQ Q
Note: See TracBrowser for help on using the repository browser.