[613] | 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 | ;
|
---|