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/XUPSUTL1.m@ 1361

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1XUPSUTL1 ;EDS/GRR - Person Service Utility Routine ;4/9/04 10:08
2 ;;8.0;KERNEL;**325**; Jul 10, 1995
3 ;;
4NMATCH(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 ;
18STNMAT(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
31STNQ Q XUPSOUT ;return 1 if match, o if no match
32 ;
Note: See TracBrowser for help on using the repository browser.