- DPTLK3 ;ALB/RMO - MAS Patient Look-up Check for Duplicates ; 22 JUN 87 1:00 pm
- ;;5.3;Patient File;**73,197,633**;Aug 13, 1993
- 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)
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDPTLK3 1328 printed Jan 18, 2025@04:01:36 Page 2
- DPTLK3 ;ALB/RMO - MAS Patient Look-up Check for Duplicates ; 22 JUN 87 1:00 pm
- +1 ;;5.3;Patient File;**73,197,633**;Aug 13, 1993
- +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 NEW DGARRY,DGVAADV,DGINS
- +3 SET (DGVAADV,DGINS)=0
- +4 IF $$INSUR^IBBAPI(DFN,,,.DGARRY,20)
- Begin DoDot:1
- +5 FOR
- SET DGINS=$ORDER(DGARRY("IBBAPI","INSUR",DGINS))
- if 'DGINS
- QUIT
- Begin DoDot:2
- +6 IF +DGARRY("IBBAPI","INSUR",DGINS,20)
- SET DGVAADV=1
- End DoDot:2
- if +DGVAADV
- QUIT
- End DoDot:1
- +7 QUIT DGVAADV