38 lines
1.5 KiB
Mathematica
38 lines
1.5 KiB
Mathematica
VBECA1A ;HIOFO/REL - Verify Patient ; 7/5/01 6:50am
|
|
;;0.5;VBECS;**294**;Sep 6, 2000
|
|
; This routine retrieves data maintained by a regulated medical
|
|
; device. The routine must not be modified by anyone other than the
|
|
; device manufacturer.
|
|
;Reference to ^DIC supported by IA #10006
|
|
;Reference to $$LRDFN^LR7OR1 supported by IA #2503
|
|
Q
|
|
PAT ; Verify Patient
|
|
N NUM,ERR,X,Y,DIC,IFN,ROOT K VBECERR S NUM=0
|
|
I $G(PATID)="" S ERR=1 D ERR
|
|
I $G(PATNAM)="" S ERR=2 D ERR
|
|
I $G(PATDOB)="" S ERR=3 D ERR
|
|
S:$G(PARENT)="" PARENT=2 I PARENT'=2&(PARENT'=67) S ERR=7 D ERR G DONE
|
|
G:$G(PATID)="" DONE
|
|
S DIC=PARENT,DIC(0)="XMZN",X=PATID D ^DIC
|
|
; ^ ADDED "N" TO DIC(0)
|
|
; TO ALLOW NUMERIC LOOKUP. RLM
|
|
I Y<1 S ERR=4 D ERR G DONE
|
|
S IFN=+Y,FILEROOT=$S(PARENT=2:"DPT(",PARENT=67:"LRT(67,",1:"")
|
|
S LRDFN=$$LRDFN^LR7OR1(IFN,FILEROOT)
|
|
I $G(PATNAM)'="",PATNAM'=$P(Y(0),"^",1) S ERR=5 D ERR
|
|
I $G(PATDOB)'="",PATDOB'=$P(Y(0),"^",3) S ERR=6 D ERR
|
|
DONE S:NUM LRDFN="" Q
|
|
;
|
|
ERR ; Set Error
|
|
I '$D(VBECERR(0)) S VBECERR(0)=$G(PATID)_"^"_$G(PATNAM)_"^"_$G(PATDOB)_"^"_$G(PARENT)
|
|
S NUM=NUM+1,VBECERR(NUM)=ERR_"^"_$P($T(ERRTX+ERR),";;",2)
|
|
Q
|
|
ERRTX ;; Error Text
|
|
;;No Patient ID supplied
|
|
;;No Patient Name supplied
|
|
;;No Patient Date of Birth supplied
|
|
;;No patient record found to match the PATID supplied
|
|
;;Patient Name (PATNAM) supplied does not match the patient ID (PATID) record
|
|
;;Patient Date of Birth (PATDOB) does not match the patient ID (PATID) record
|
|
;;Unsupported Parent File (PARENT) supplied
|