- 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 Feb 19, 2025@00:10:12 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
