VBECA1A ;HIOFO/REL - Verify Patient ; 7/5/01 6:50am
;;2.0;VBEC;;Jun 05, 2015;Build 4
;
; Note: This routine supports data exchange with an FDA registered
; medical device. As such, it may not be changed in any way without
; prior written approval from the medical device manufacturer.
;
; Integration Agreements:
; Reference to ^DIC supported by IA #10006
; Reference to $$LRDFN^LR7OR1 supported by IA #2503
;
QUIT
;
PAT ; Verify Patient
N NUM,ERR,X,Y,DIC,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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECA1A 1668 printed Oct 16, 2024@18:43:59 Page 2
VBECA1A ;HIOFO/REL - Verify Patient ; 7/5/01 6:50am
+1 ;;2.0;VBEC;;Jun 05, 2015;Build 4
+2 ;
+3 ; Note: This routine supports data exchange with an FDA registered
+4 ; medical device. As such, it may not be changed in any way without
+5 ; prior written approval from the medical device manufacturer.
+6 ;
+7 ; Integration Agreements:
+8 ; Reference to ^DIC supported by IA #10006
+9 ; Reference to $$LRDFN^LR7OR1 supported by IA #2503
+10 ;
+11 QUIT
+12 ;
PAT ; Verify Patient
+1 NEW NUM,ERR,X,Y,DIC,ROOT
KILL VBECERR
SET NUM=0
+2 IF $GET(PATID)=""
SET ERR=1
DO ERR
+3 IF $GET(PATNAM)=""
SET ERR=2
DO ERR
+4 IF $GET(PATDOB)=""
SET ERR=3
DO ERR
+5 if $GET(PARENT)=""
SET PARENT=2
IF PARENT'=2&(PARENT'=67)
SET ERR=7
DO ERR
GOTO DONE
+6 if $GET(PATID)=""
GOTO DONE
+7 SET DIC=PARENT
SET DIC(0)="XMZN"
SET X=PATID
DO ^DIC
+8 ; ^ ADDED "N" TO DIC(0)
+9 ; TO ALLOW NUMERIC LOOKUP. RLM
+10 IF Y<1
SET ERR=4
DO ERR
GOTO DONE
+11 SET IFN=+Y
SET FILEROOT=$SELECT(PARENT=2:"DPT(",PARENT=67:"LRT(67,",1:"")
+12 SET LRDFN=$$LRDFN^LR7OR1(IFN,FILEROOT)
+13 IF $GET(PATNAM)'=""
IF PATNAM'=$PIECE(Y(0),"^",1)
SET ERR=5
DO ERR
+14 IF $GET(PATDOB)'=""
IF PATDOB'=$PIECE(Y(0),"^",3)
SET ERR=6
DO ERR
DONE if NUM
SET LRDFN=""
QUIT
+1 ;
ERR ; Set Error
+1 IF '$DATA(VBECERR(0))
SET VBECERR(0)=$GET(PATID)_"^"_$GET(PATNAM)_"^"_$GET(PATDOB)_"^"_$GET(PARENT)
+2 SET NUM=NUM+1
SET VBECERR(NUM)=ERR_"^"_$PIECE($TEXT(ERRTX+ERR),";;",2)
+3 QUIT
ERRTX ;; Error Text
+1 ;;No Patient ID supplied
+2 ;;No Patient Name supplied
+3 ;;No Patient Date of Birth supplied
+4 ;;No patient record found to match the PATID supplied
+5 ;;Patient Name (PATNAM) supplied does not match the patient ID (PATID) record
+6 ;;Patient Date of Birth (PATDOB) does not match the patient ID (PATID) record
+7 ;;Unsupported Parent File (PARENT) supplied
