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 ---[H[J[2J[HLRUBL 795 printed Dec 13, 2024@02:21:16 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
