AUPNLK3.m

AUPNLK3 ; IHS/CMI/LAB - IHS PATIENT LOOKUP CHECK FOR DUPLICATES ;

 ;;99.1;IHS DICTIONARIES (PATIENT);;MAR 09, 1999

 ;'Modified' MAS Patient Look-up Check for Duplicates, June 1987

 ;

 ; Upon exiting this routine AUPNLK3 will be set as follows:

 ;

 ;          AUPNLK3 =  0 means ok to add patient

 ;          AUPNLK3 = -1 means do not add patient

 ;

 ; AUPQF3 values have the following meaing.

 ;

 ;        0 = Initial state

 ;        1 = Missing fields

 ;        2 = No potential duplicates

 ;        3 = Operator said no

 ;        4 = Operator said yes

 ;

START ;

 D INIT ;                    Initialization

 I AUPQF3 D EOJ Q

 D SEARCH ;                  Do search

 I AUPQF3 D EOJ Q

 D SHOW ;                    Show list of potential duplicates

 D ASK ;                     See if still want to add

 D EOJ

 Q

 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 ;

SEARCH ; SEARCH FOR POTENTIAL DUPLICATES

 S AUPNM=AUPX,SEX=AUPIDS(.02),DOB=AUPIDS(.03),SSN=AUPIDS(.09)

 W !!?3,"...searching for potential duplicates"

 D ^AUPNLKD

 I 'AUPD W !!?3,"No potential duplicates have been identified." S AUPQF3=2 Q

 Q

 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 ;

SHOW ; SHOW LIST OF POTENTIAL DUPLICATES

 W !!?3,*7,"The following patients have been identified as potential duplicates:",!

 F Y=0:0 S Y=$O(AUPD(Y)) Q:'Y  W !?5,$P(^DPT(Y,0),U) X DIC("W") I $D(^DPT(Y,.01)) F AUPAN=0:0 S AUPAN=$O(^DPT(Y,.01,AUPAN)) Q:AUPAN'=+AUPAN  I $D(^(AUPAN,0)) W !?10,$P(^(0),U,1)

 Q

 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 ;

ASK ; ASK OPERATOR

 F AUPL=0:0 D ASKADD Q:%

 I %'=1 S AUPQF3=3 Q

 S AUPQF3=4

 Q

 ;

ASKADD ;

 W !!?3,"Do you still want to add '",AUPX,"' as a new patient"

 S %=2 D YN^DICN I '% W !!?6,"Enter 'YES' to add new patient, or 'NO' not to." Q

 Q

 ;

 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 ;

INIT ; INITIALIZATION

 S AUPQF3=0

 I '$D(AUPX)!('$D(AUPIDS(.02)))!('$D(AUPIDS(.03)))!('$D(AUPIDS(.09))) W !?3,*7,"Unable to search for potential duplicates, Sex, Date of Birth and",!?3,"Social Security Number must be defined." S AUPQF3=1 Q

 Q

 ;

 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 ;

EOJ ;

 S AUPNLK3=$S(AUPQF3#2:-1,1:0)

 K AUPAN,AUPD,AUPNM,AUPQF3

 K DOB,SEX,SSN

 Q

AUPNLK3   ; IHS/CMI/LAB - IHS PATIENT LOOKUP CHECK FOR DUPLICATES ;

 +1       ;;99.1;IHS DICTIONARIES (PATIENT);;MAR 09, 1999

 +2       ;'Modified' MAS Patient Look-up Check for Duplicates, June 1987

 +3       ;

 +4       ; Upon exiting this routine AUPNLK3 will be set as follows:

 +5       ;

 +6       ;          AUPNLK3 =  0 means ok to add patient

 +7       ;          AUPNLK3 = -1 means do not add patient

 +8       ;

 +9       ; AUPQF3 values have the following meaing.

 +10      ;

 +11      ;        0 = Initial state

 +12      ;        1 = Missing fields

 +13      ;        2 = No potential duplicates

 +14      ;        3 = Operator said no

 +15      ;        4 = Operator said yes

 +16      ;

START     ;

 +1       ;                    Initialization

           DO INIT

 +2        IF AUPQF3

               DO EOJ

               QUIT 

 +3       ;                  Do search

           DO SEARCH

 +4        IF AUPQF3

               DO EOJ

               QUIT 

 +5       ;                    Show list of potential duplicates

           DO SHOW

 +6       ;                     See if still want to add

           DO ASK

 +7        DO EOJ

 +8        QUIT 

 +9       ; - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 +10      ;

SEARCH    ; SEARCH FOR POTENTIAL DUPLICATES

 +1        SET AUPNM=AUPX

           SET SEX=AUPIDS(.02)

           SET DOB=AUPIDS(.03)

           SET SSN=AUPIDS(.09)

 +2        WRITE !!?3,"...searching for potential duplicates"

 +3        DO ^AUPNLKD

 +4        IF 'AUPD

               WRITE !!?3,"No potential duplicates have been identified."

               SET AUPQF3=2

               QUIT 

 +5        QUIT 

 +6       ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 +7       ;

SHOW      ; SHOW LIST OF POTENTIAL DUPLICATES

 +1        WRITE !!?3,*7,"The following patients have been identified as potential duplicates:",!

 +2        FOR Y=0:0

               SET Y=$ORDER(AUPD(Y))

               IF 'Y

                   QUIT 

               WRITE !?5,$PIECE(^DPT(Y,0),U)

               XECUTE DIC("W")

               IF $DATA(^DPT(Y,.01))

                   FOR AUPAN=0:0

                       SET AUPAN=$ORDER(^DPT(Y,.01,AUPAN))

                       IF AUPAN'=+AUPAN

                           QUIT 

                       IF $DATA(^(AUPAN,0))

                           WRITE !?10,$PIECE(^(0),U,1)

 +3        QUIT 

 +4       ; - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 +5       ;

ASK       ; ASK OPERATOR

 +1        FOR AUPL=0:0

               DO ASKADD

               IF %

                   QUIT 

 +2        IF %'=1

               SET AUPQF3=3

               QUIT 

 +3        SET AUPQF3=4

 +4        QUIT 

 +5       ;

ASKADD    ;

 +1        WRITE !!?3,"Do you still want to add '",AUPX,"' as a new patient"

 +2        SET %=2

           DO YN^DICN

           IF '%

               WRITE !!?6,"Enter 'YES' to add new patient, or 'NO' not to."

               QUIT 

 +3        QUIT 

 +4       ;

 +5       ; - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 +6       ;

INIT      ; INITIALIZATION

 +1        SET AUPQF3=0

 +2        IF '$DATA(AUPX)!('$DATA(AUPIDS(.02)))!('$DATA(AUPIDS(.03)))!('$DATA(AUPIDS(.09)))

               WRITE !?3,*7,"Unable to search for potential duplicates, Sex, Date of Birth and",!?3,"Social Security Number must be defined."

               SET AUPQF3=1

               QUIT 

 +3        QUIT 

 +4       ;

 +5       ; - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 +6       ;

EOJ       ;

 +1        SET AUPNLK3=$SELECT(AUPQF3#2:-1,1:0)

 +2        KILL AUPAN,AUPD,AUPNM,AUPQF3

 +3        KILL DOB,SEX,SSN

 +4        QUIT