LRCKF62.m

LRCKF62 ;SLC/RWF - CHECK FILE'S ACC TEST FILE ; 2/22/87  1:46 PM ;

 ;;5.2;LAB SERVICE;**272,293**;Sep 27, 1994

 S ZTRTN="ENT^LRCKF62" D LOG^LRCKF Q:LREND  D ENT W !! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q

ENT ;from LRCKF

 U IO W !,"  Checking the Accession test group file." S U="^",LRPA=0

 F LRA=0:0 S LRA=$O(^LAB(62.6,LRA)) Q:LRA'>0  S Z0=^LAB(62.6,LRA,0),LRB=0 D ATF

END K LRB,LRPA,LRPB W !! W:$E(IOST,1,2)="P-" @IOF Q

 Q

ATF S LRB=$O(^LAB(62.6,LRA,1,LRB)) Q:LRB'>0!('$D(^(+LRB,0))#2)  S Z1=^(0)

 S Z2=$S($D(^LAB(60,+Z1,0)):^(0),1:"") I Z2="" D NAME1 W !?5,"F- Pointer ",+Z1," doesn't point to a test in file 60."

 I '$P(Z2,U,9),$P(Z0,U,4) D NAME1 W !,?5,"F- Test doesn't have a LAB COLLECTION SAMPLE."

 G ATF

NAME1 I LRPA'=LRA W !!,$P(Z0,U) S LRPA=LRA,LRPB=0

 I LRPB'=LRB W !?2,$P(Z2,U) S LRPB=LRB

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRCKF62   817     printed  Apr 09, 2024@21:23:08                                                                                                                                                                                                      Page 2

LRCKF62   ;SLC/RWF - CHECK FILE'S ACC TEST FILE ; 2/22/87  1:46 PM ;

 +1       ;;5.2;LAB SERVICE;**272,293**;Sep 27, 1994

 +2        SET ZTRTN="ENT^LRCKF62"

           DO LOG^LRCKF

           if LREND

               QUIT 

           DO ENT

           WRITE !!

           if $EXTRACT(IOST,1,2)="P-"

               WRITE @IOF

           DO ^%ZISC

           QUIT 

ENT       ;from LRCKF

 +1        USE IO

           WRITE !,"  Checking the Accession test group file."

           SET U="^"

           SET LRPA=0

 +2        FOR LRA=0:0

               SET LRA=$ORDER(^LAB(62.6,LRA))

               if LRA'>0

                   QUIT 

               SET Z0=^LAB(62.6,LRA,0)

               SET LRB=0

               DO ATF

END        KILL LRB,LRPA,LRPB

           WRITE !!

           if $EXTRACT(IOST,1,2)="P-"

               WRITE @IOF

           QUIT 

 +1        QUIT 

ATF        SET LRB=$ORDER(^LAB(62.6,LRA,1,LRB))

           if LRB'>0!('$DATA(^(+LRB,0))#2)

               QUIT 

           SET Z1=^(0)

 +1        SET Z2=$SELECT($DATA(^LAB(60,+Z1,0)):^(0),1:"")

           IF Z2=""

               DO NAME1

               WRITE !?5,"F- Pointer ",+Z1," doesn't point to a test in file 60."

 +2        IF '$PIECE(Z2,U,9)

               IF $PIECE(Z0,U,4)

                   DO NAME1

                   WRITE !,?5,"F- Test doesn't have a LAB COLLECTION SAMPLE."

 +3        GOTO ATF

NAME1      IF LRPA'=LRA

               WRITE !!,$PIECE(Z0,U)

               SET LRPA=LRA

               SET LRPB=0

 +1        IF LRPB'=LRB

               WRITE !?2,$PIECE(Z2,U)

               SET LRPB=LRB

 +2        QUIT