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