XUPSUTL1.m

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 ---XUPSUTL1   1686     printed  Apr 09, 2024@21:07:09                                                                                                                                                                                                    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       ;