XUPSUTL1 ;EDS/GRR - Person Service Utility Routine ;4/9/04 10:08
;;8.0;KERNEL;**325**; Jul 10, 1995
;;
NMATCH(XUPSIEN,XUPSFNAM) ;
;;Match on First Name
;;Input Parameters:
;; XUPSIEN - Internal Entry Number of New Person entry
;; XUPSFNAM - Part or all of Person first name
;;Output:
;; XUPSOUT - 1 if name matched, 0 if name did not match
N XUPSA,XUPSHFN,XUPSFN,XUPSNFN,XUPSOUT ;establish new variables
S XUPSFN=$P($G(^VA(200,XUPSIEN,0)),"^",1) ;get full name
S XUPSHFN=$$HLNAME^HLFNC(XUPSFN,"~|\/") ;change to HL7 format (last name~first name~middle name)
S XUPSNFN=$P(XUPSHFN,"~",2) ;get first name
S XUPSOUT=$S($E(XUPSNFN,1,$L(XUPSFNAM))[XUPSFNAM:1,1:0) ; match first name to first name passed
Q XUPSOUT ;return 1 if name matched, 0 if no match
;
STNMAT(XUPSIEN,XUPSSTN) ;
;;Station Number matching
;;Input Parameters:
;; XUPSIEN - Internal Entry Number of New Person entry
;; XUPSSTN - 3-6 character station number to use as screen
;; (i.e. 603 or 528A4)
;;Output:
;; XUPSOUT - 1 if station matched, 0 if no station match
N XUPSOUT,XUPSDIV,%,A,VASITE,XUPSNDT ;establish new variables
S XUPSDIV=0,XUPSOUT=0 ;initialize new variables
D NOW^%DTC S XUPSNDT=%\1 ;get current date
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
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
STNQ Q XUPSOUT ;return 1 if match, o if no match
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUPSUTL1 1686 printed Oct 16, 2024@18:12:36 Page 2
XUPSUTL1 ;EDS/GRR - Person Service Utility Routine ;4/9/04 10:08
+1 ;;8.0;KERNEL;**325**; Jul 10, 1995
+2 ;;
NMATCH(XUPSIEN,XUPSFNAM) ;
+1 ;;Match on First Name
+2 ;;Input Parameters:
+3 ;; XUPSIEN - Internal Entry Number of New Person entry
+4 ;; XUPSFNAM - Part or all of Person first name
+5 ;;Output:
+6 ;; XUPSOUT - 1 if name matched, 0 if name did not match
+7 ;establish new variables
NEW XUPSA,XUPSHFN,XUPSFN,XUPSNFN,XUPSOUT
+8 ;get full name
SET XUPSFN=$PIECE($GET(^VA(200,XUPSIEN,0)),"^",1)
+9 ;change to HL7 format (last name~first name~middle name)
SET XUPSHFN=$$HLNAME^HLFNC(XUPSFN,"~|\/")
+10 ;get first name
SET XUPSNFN=$PIECE(XUPSHFN,"~",2)
+11 ; match first name to first name passed
SET XUPSOUT=$SELECT($EXTRACT(XUPSNFN,1,$LENGTH(XUPSFNAM))[XUPSFNAM:1,1:0)
+12 ;return 1 if name matched, 0 if no match
QUIT XUPSOUT
+13 ;
STNMAT(XUPSIEN,XUPSSTN) ;
+1 ;;Station Number matching
+2 ;;Input Parameters:
+3 ;; XUPSIEN - Internal Entry Number of New Person entry
+4 ;; XUPSSTN - 3-6 character station number to use as screen
+5 ;; (i.e. 603 or 528A4)
+6 ;;Output:
+7 ;; XUPSOUT - 1 if station matched, 0 if no station match
+8 ;establish new variables
NEW XUPSOUT,XUPSDIV,%,A,VASITE,XUPSNDT
+9 ;initialize new variables
SET XUPSDIV=0
SET XUPSOUT=0
+10 ;get current date
DO NOW^%DTC
SET XUPSNDT=%\1
+11 ;if user has no division assigned, get default division and check for match
IF '$ORDER(^VA(200,XUPSIEN,2,0))
SET A=$$ALL^VASITE(XUPSNDT)
if '$DATA(VASITE(XUPSSTN))
GOTO STNQ
SET XUPSOUT=1
GOTO STNQ
+12 ;loop through all divisions assigned and check for match
FOR
SET XUPSDIV=$ORDER(^VA(200,XUPSIEN,2,XUPSDIV))
if XUPSDIV'>0
QUIT
IF $PIECE($GET(^DIC(4,XUPSDIV,99)),"^",1)=XUPSSTN
SET XUPSOUT=1
QUIT
STNQ ;return 1 if match, o if no match
QUIT XUPSOUT
+1 ;
