LRUQ ;AVAMC/REG - CHECK FOR BAD POINTERS TO LAB FILE ;2/18/93 13:13
;;5.2;LAB SERVICE;**242**;Sep 27, 1994
D END W !!,"Check parent file for bad pointers to lab file."
S X="?" D FILE^LRDPA G:Y<1 END S LRF=+Y,LRN=$P(Y,U,2),LR=^DIC(LRF,0,"GL")
D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO D L^LRU,S^LRU,H S LR("F")=1
F DFN=0:0 S DFN=$O(@(LR_DFN_")")) Q:'DFN!(LR("Q")) D
.S LRDFN=$$LRDFN^LR7OR1(DFN) Q:LRDFN="" D LR
D END^LRUTL,END Q
LR S X=$S($D(^LR(LRDFN,0)):^(0),1:"") I X="" D:$Y>(IOSL-6) H Q:LR("Q") W !,DFN,?15,LRDFN," no entry in lab data file" Q
S LR(2)=$P(X,"^",2),LR(3)=$P(X,"^",3) I DFN'=LR(3)!(LR(2)'=LRF) D:$Y>(IOSL-6) H Q:LR("Q") W !,DFN,?15,LRDFN,?30,LR(3),?45,LR(2)
Q
;
H I $D(LR("F")),IOST?1"C".E D M^LRU Q
D F^LRU W !,"Bad lab pointers from ",LRN," file (global ",LR," )"
W !,"Parent DFN",?15,"Parent LRDFN",?30,"Lab DFN",?45,"Lab pointer to parent file",!,LR("%") Q
;
END D V^LRU Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUQ 931 printed Dec 13, 2024@02:22:04 Page 2
LRUQ ;AVAMC/REG - CHECK FOR BAD POINTERS TO LAB FILE ;2/18/93 13:13
+1 ;;5.2;LAB SERVICE;**242**;Sep 27, 1994
+2 DO END
WRITE !!,"Check parent file for bad pointers to lab file."
+3 SET X="?"
DO FILE^LRDPA
if Y<1
GOTO END
SET LRF=+Y
SET LRN=$PIECE(Y,U,2)
SET LR=^DIC(LRF,0,"GL")
+4 DO BEG^LRUTL
if POP!($DATA(ZTSK))
GOTO END
QUE USE IO
DO L^LRU
DO S^LRU
DO H
SET LR("F")=1
+1 FOR DFN=0:0
SET DFN=$ORDER(@(LR_DFN_")"))
if 'DFN!(LR("Q"))
QUIT
Begin DoDot:1
+2 SET LRDFN=$$LRDFN^LR7OR1(DFN)
if LRDFN=""
QUIT
DO LR
End DoDot:1
+3 DO END^LRUTL
DO END
QUIT
LR SET X=$SELECT($DATA(^LR(LRDFN,0)):^(0),1:"")
IF X=""
if $Y>(IOSL-6)
DO H
if LR("Q")
QUIT
WRITE !,DFN,?15,LRDFN," no entry in lab data file"
QUIT
+1 SET LR(2)=$PIECE(X,"^",2)
SET LR(3)=$PIECE(X,"^",3)
IF DFN'=LR(3)!(LR(2)'=LRF)
if $Y>(IOSL-6)
DO H
if LR("Q")
QUIT
WRITE !,DFN,?15,LRDFN,?30,LR(3),?45,LR(2)
+2 QUIT
+3 ;
H IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
QUIT
+1 DO F^LRU
WRITE !,"Bad lab pointers from ",LRN," file (global ",LR," )"
+2 WRITE !,"Parent DFN",?15,"Parent LRDFN",?30,"Lab DFN",?45,"Lab pointer to parent file",!,LR("%")
QUIT
+3 ;
END DO V^LRU
QUIT
