LRUBL.m

LRUBL ;AVAMC/REG - FIND PATIENT MISMATCHES  ;2/18/93  13:24

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 D END W !!,"FIND PATIENT MISMATCHES IN VA PATIENT NUMBER FIELD OF FILE 65"

 S ZTRTN="QUE^LRUBL" D BEG^LRUTL G:POP!($D(ZTSK)) END

QUE U IO D H S (A,C,M)=0 F LRC=0:1 S A=$O(^LRD(65,A)) Q:'A  F B=0:0 S B=$O(^LRD(65,A,3,B)) Q:'B  S X=^(B,0),P=$P(X,"^",6),DFN=$P(X,"^",7) I DFN,$D(^DPT(DFN,0)) S C=C+1,Y=^(0) I $P(Y,"^")'=P D W

 W !!,"# units: ",LRC,!,"# relocations: ",C,!,"# missmatches: ",M D END^LRUTL,END Q

W W !!,P," not ",$P(Y,"^")," (SSN: ",$P(Y,"^",9),") Unit IFN:",A S M=M+1

 W !,"DATE/TIME RELOCATION: " S Y=+X D D^DIQ W Y,?45,"Unit ID: ",$P(^LRD(65,A,0),"^") Q

 ;

H S X="N",%DT="T" D ^%DT,D^DIQ W @IOF,Y," ",$$INS^LRU,!,"PATIENT MISMATCHES IN 65.03,.07 DATA ELEMENT" Q

END D V^LRU Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRUBL   795     printed  Feb 18, 2025@23:47:08                                                                                                                                                                                                        Page 2

LRUBL     ;AVAMC/REG - FIND PATIENT MISMATCHES  ;2/18/93  13:24

 +1       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +2        DO END

           WRITE !!,"FIND PATIENT MISMATCHES IN VA PATIENT NUMBER FIELD OF FILE 65"

 +3        SET ZTRTN="QUE^LRUBL"

           DO BEG^LRUTL

           if POP!($DATA(ZTSK))

               GOTO END

QUE        USE IO

           DO H

           SET (A,C,M)=0

           FOR LRC=0:1

               SET A=$ORDER(^LRD(65,A))

               if 'A

                   QUIT 

               FOR B=0:0

                   SET B=$ORDER(^LRD(65,A,3,B))

                   if 'B

                       QUIT 

                   SET X=^(B,0)

                   SET P=$PIECE(X,"^",6)

                   SET DFN=$PIECE(X,"^",7)

                   IF DFN

                       IF $DATA(^DPT(DFN,0))

                           SET C=C+1

                           SET Y=^(0)

                           IF $PIECE(Y,"^")'=P

                               DO W

 +1        WRITE !!,"# units: ",LRC,!,"# relocations: ",C,!,"# missmatches: ",M

           DO END^LRUTL

           DO END

           QUIT 

W          WRITE !!,P," not ",$PIECE(Y,"^")," (SSN: ",$PIECE(Y,"^",9),") Unit IFN:",A

           SET M=M+1

 +1        WRITE !,"DATE/TIME RELOCATION: "

           SET Y=+X

           DO D^DIQ

           WRITE Y,?45,"Unit ID: ",$PIECE(^LRD(65,A,0),"^")

           QUIT 

 +2       ;

H          SET X="N"

           SET %DT="T"

           DO ^%DT

           DO D^DIQ

           WRITE @IOF,Y," ",$$INS^LRU,!,"PATIENT MISMATCHES IN 65.03,.07 DATA ELEMENT"

           QUIT 

END        DO V^LRU

           QUIT