VBECA1A.m

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 ---VBECA1A   1668     printed  Apr 09, 2024@21:45:35                                                                                                                                                                                                     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