source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DPTLK3.m@ 1389

Last change on this file since 1389 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1DPTLK3 ;ALB/RMO - MAS Patient Look-up Check for Duplicates ; 22 JUN 87 1:00 pm
2 ;;5.3;Patient File;**73,197,633**;Aug 13, 1993
3 I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY
4 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
5EP2 ; -- Entry point 2
6 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
7 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"")"
8 ;
9ASKADD 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
10 ;
11Q K DOB,DPTD,DPTKD,DPTKS,DPTNM,SSN
12 Q
13VAADV(DFN) ;Check if VA ADVANTAGE PLAN
14 ;Returns 0, or 1 (VA ADVANTAGE PLAN)
15 N DGARRY,DGVAADV,DGINS
16 S (DGVAADV,DGINS)=0
17 I $$INSUR^IBBAPI(DFN,,,.DGARRY,20) D
18 . F S DGINS=$O(DGARRY("IBBAPI","INSUR",DGINS)) Q:'DGINS D Q:+DGVAADV
19 . . I +DGARRY("IBBAPI","INSUR",DGINS,20) S DGVAADV=1
20 Q DGVAADV
Note: See TracBrowser for help on using the repository browser.