source: WorldVistAEHR/trunk/r/VBECS-VBEC/VBECA1A.m@ 1476

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1VBECA1A ;HIOFO/REL - Verify Patient ; 7/5/01 6:50am
2 ;;0.5;VBECS;**294**;Sep 6, 2000
3 ; This routine retrieves data maintained by a regulated medical
4 ; device. The routine must not be modified by anyone other than the
5 ; device manufacturer.
6 ;Reference to ^DIC supported by IA #10006
7 ;Reference to $$LRDFN^LR7OR1 supported by IA #2503
8 Q
9PAT ; Verify Patient
10 N NUM,ERR,X,Y,DIC,IFN,ROOT K VBECERR S NUM=0
11 I $G(PATID)="" S ERR=1 D ERR
12 I $G(PATNAM)="" S ERR=2 D ERR
13 I $G(PATDOB)="" S ERR=3 D ERR
14 S:$G(PARENT)="" PARENT=2 I PARENT'=2&(PARENT'=67) S ERR=7 D ERR G DONE
15 G:$G(PATID)="" DONE
16 S DIC=PARENT,DIC(0)="XMZN",X=PATID D ^DIC
17 ; ^ ADDED "N" TO DIC(0)
18 ; TO ALLOW NUMERIC LOOKUP. RLM
19 I Y<1 S ERR=4 D ERR G DONE
20 S IFN=+Y,FILEROOT=$S(PARENT=2:"DPT(",PARENT=67:"LRT(67,",1:"")
21 S LRDFN=$$LRDFN^LR7OR1(IFN,FILEROOT)
22 I $G(PATNAM)'="",PATNAM'=$P(Y(0),"^",1) S ERR=5 D ERR
23 I $G(PATDOB)'="",PATDOB'=$P(Y(0),"^",3) S ERR=6 D ERR
24DONE S:NUM LRDFN="" Q
25 ;
26ERR ; Set Error
27 I '$D(VBECERR(0)) S VBECERR(0)=$G(PATID)_"^"_$G(PATNAM)_"^"_$G(PATDOB)_"^"_$G(PARENT)
28 S NUM=NUM+1,VBECERR(NUM)=ERR_"^"_$P($T(ERRTX+ERR),";;",2)
29 Q
30ERRTX ;; Error Text
31 ;;No Patient ID supplied
32 ;;No Patient Name supplied
33 ;;No Patient Date of Birth supplied
34 ;;No patient record found to match the PATID supplied
35 ;;Patient Name (PATNAM) supplied does not match the patient ID (PATID) record
36 ;;Patient Date of Birth (PATDOB) does not match the patient ID (PATID) record
37 ;;Unsupported Parent File (PARENT) supplied
Note: See TracBrowser for help on using the repository browser.