DPTLK3.m

DPTLK3 ;ALB/RMO - MAS Patient Look-up Check for Duplicates ; 22 JUN 87 1:00 pm

 ;;5.3;Patient File;**73,197,633,1015**;Aug 13, 1993;Build 21

 I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY

 I '$D(DPTX)!('$D(DPTIDS(.03)))!('$D(DPTIDS(.09))) W !?3,*7,"Unable to search for potential duplicates, Date of Birth and",!?3,"Social Security Number must be defined." S DPTDFN=-1 G Q

EP2 ; -- Entry point 2

 S DPTNM=DPTX,DOB=DPTIDS(.03),SSN=DPTIDS(.09),(DPTKD,DPTKS)=0 W ! W:'$D(DDS) !?3 W "...searching for potential duplicates" D ^DPTDUP I 'DPTD W !!?3,"No potential duplicates have been identified." S DPTDFN=1 G Q

 W ! W:'$D(DDS) !?3 W *7,"The following patients have been identified as potential duplicates:",! F Y=0:0 S Y=$O(DPTD(Y)) Q:'Y  W !?5,$P(^DPT(Y,0),U) X "N DDS X DIC(""W"")"

 ;

ASKADD W !!?3,"Do you still want to add '",DPTX,"' as a new patient" S %=2 D YN^DICN S DPTDFN=$S(%<0!(%=2):-1,%=1:1,1:0) I 'DPTDFN W !!?6,"Enter 'YES' to add new patient, or 'NO' not to." G ASKADD

 ;

Q K DOB,DPTD,DPTKD,DPTKS,DPTNM,SSN

 Q

VAADV(DFN) ;Check if VA ADVANTAGE PLAN

 ;Returns 0, or 1 (VA ADVANTAGE PLAN)

 Q 0 ;ihs/cmi/maw 02/08/2012 patch 1014 no IB in IHS

 N DGARRY,DGVAADV,DGINS

 S (DGVAADV,DGINS)=0

 I $$INSUR^IBBAPI(DFN,,,.DGARRY,20) D

 . F  S DGINS=$O(DGARRY("IBBAPI","INSUR",DGINS)) Q:'DGINS  D  Q:+DGVAADV

 . . I +DGARRY("IBBAPI","INSUR",DGINS,20) S DGVAADV=1

 Q DGVAADV

DPTLK3    ;ALB/RMO - MAS Patient Look-up Check for Duplicates ; 22 JUN 87 1:00 pm

 +1       ;;5.3;Patient File;**73,197,633,1015**;Aug 13, 1993;Build 21

 +2        IF $DATA(DDS)

               DO CLRMSG^DDS

               SET DX=0

               SET DY=DDSHBX+1

               XECUTE DDXY

 +3        IF '$DATA(DPTX)!('$DATA(DPTIDS(.03)))!('$DATA(DPTIDS(.09)))

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

               SET DPTDFN=-1

               GOTO Q

EP2       ; -- Entry point 2

 +1        SET DPTNM=DPTX

           SET DOB=DPTIDS(.03)

           SET SSN=DPTIDS(.09)

           SET (DPTKD,DPTKS)=0

           WRITE !

           IF '$DATA(DDS)

               WRITE !?3

           WRITE "...searching for potential duplicates"

           DO ^DPTDUP

           IF 'DPTD

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

               SET DPTDFN=1

               GOTO Q

 +2        WRITE !

           IF '$DATA(DDS)

               WRITE !?3

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

           FOR Y=0:0

               SET Y=$ORDER(DPTD(Y))

               IF 'Y

                   QUIT 

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

               XECUTE "N DDS X DIC(""W"")"

 +3       ;

ASKADD     WRITE !!?3,"Do you still want to add '",DPTX,"' as a new patient"

           SET %=2

           DO YN^DICN

           SET DPTDFN=$SELECT(%<0!(%=2):-1,%=1:1,1:0)

           IF 'DPTDFN

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

               GOTO ASKADD

 +1       ;

Q          KILL DOB,DPTD,DPTKD,DPTKS,DPTNM,SSN

 +1        QUIT 

VAADV(DFN) ;Check if VA ADVANTAGE PLAN

 +1       ;Returns 0, or 1 (VA ADVANTAGE PLAN)

 +2       ;ihs/cmi/maw 02/08/2012 patch 1014 no IB in IHS

           QUIT 0

 +3        NEW DGARRY,DGVAADV,DGINS

 +4        SET (DGVAADV,DGINS)=0

 +5        IF $$INSUR^IBBAPI(DFN,,,.DGARRY,20)

               Begin DoDot:1

 +6                FOR 

                       SET DGINS=$ORDER(DGARRY("IBBAPI","INSUR",DGINS))

                       IF 'DGINS

                           QUIT 

                       Begin DoDot:2

 +7                        IF +DGARRY("IBBAPI","INSUR",DGINS,20)

                               SET DGVAADV=1

                       End DoDot:2

                       IF +DGVAADV

                           QUIT 

               End DoDot:1

 +8        QUIT DGVAADV