- LRUQ ;AVAMC/REG - CHECK FOR BAD POINTERS TO LAB FILE ;2/18/93 13:13
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;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
- LRUQ ;AVAMC/REG - CHECK FOR BAD POINTERS TO LAB FILE ;2/18/93 13:13
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**242**;Sep 27, 1994
- +3 DO END
- WRITE !!,"Check parent file for bad pointers to lab file."
- +4 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")
- +5 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
