1 | XUPSUTL1 ;EDS/GRR - Person Service Utility Routine ;4/9/04 10:08
|
---|
2 | ;;8.0;KERNEL;**325**; Jul 10, 1995
|
---|
3 | ;;
|
---|
4 | NMATCH(XUPSIEN,XUPSFNAM) ;
|
---|
5 | ;;Match on First Name
|
---|
6 | ;;Input Parameters:
|
---|
7 | ;; XUPSIEN - Internal Entry Number of New Person entry
|
---|
8 | ;; XUPSFNAM - Part or all of Person first name
|
---|
9 | ;;Output:
|
---|
10 | ;; XUPSOUT - 1 if name matched, 0 if name did not match
|
---|
11 | N XUPSA,XUPSHFN,XUPSFN,XUPSNFN,XUPSOUT ;establish new variables
|
---|
12 | S XUPSFN=$P($G(^VA(200,XUPSIEN,0)),"^",1) ;get full name
|
---|
13 | S XUPSHFN=$$HLNAME^HLFNC(XUPSFN,"~|\/") ;change to HL7 format (last name~first name~middle name)
|
---|
14 | S XUPSNFN=$P(XUPSHFN,"~",2) ;get first name
|
---|
15 | S XUPSOUT=$S($E(XUPSNFN,1,$L(XUPSFNAM))[XUPSFNAM:1,1:0) ; match first name to first name passed
|
---|
16 | Q XUPSOUT ;return 1 if name matched, 0 if no match
|
---|
17 | ;
|
---|
18 | STNMAT(XUPSIEN,XUPSSTN) ;
|
---|
19 | ;;Station Number matching
|
---|
20 | ;;Input Parameters:
|
---|
21 | ;; XUPSIEN - Internal Entry Number of New Person entry
|
---|
22 | ;; XUPSSTN - 3-6 character station number to use as screen
|
---|
23 | ;; (i.e. 603 or 528A4)
|
---|
24 | ;;Output:
|
---|
25 | ;; XUPSOUT - 1 if station matched, 0 if no station match
|
---|
26 | N XUPSOUT,XUPSDIV,%,A,VASITE,XUPSNDT ;establish new variables
|
---|
27 | S XUPSDIV=0,XUPSOUT=0 ;initialize new variables
|
---|
28 | D NOW^%DTC S XUPSNDT=%\1 ;get current date
|
---|
29 | I '$O(^VA(200,XUPSIEN,2,0)) S A=$$ALL^VASITE(XUPSNDT) G STNQ:'$D(VASITE(XUPSSTN)) S XUPSOUT=1 G STNQ ;if user has no division assigned, get default division and check for match
|
---|
30 | F S XUPSDIV=$O(^VA(200,XUPSIEN,2,XUPSDIV)) Q:XUPSDIV'>0 I $P($G(^DIC(4,XUPSDIV,99)),"^",1)=XUPSSTN S XUPSOUT=1 Q ;loop through all divisions assigned and check for match
|
---|
31 | STNQ Q XUPSOUT ;return 1 if match, o if no match
|
---|
32 | ;
|
---|