- 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 Feb 18, 2025@23:38:14 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 ;