source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCKF62.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 802 bytes
Line 
1LRCKF62 ;SLC/RWF - CHECK FILE'S ACC TEST FILE ; 2/22/87 1:46 PM ;
2 ;;5.2;LAB SERVICE;**272,293**;Sep 27, 1994
3 S ZTRTN="ENT^LRCKF62" D LOG^LRCKF Q:LREND D ENT W !! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q
4ENT ;from LRCKF
5 U IO W !," Checking the Accession test group file." S U="^",LRPA=0
6 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
7END K LRB,LRPA,LRPB W !! W:$E(IOST,1,2)="P-" @IOF Q
8 Q
9ATF S LRB=$O(^LAB(62.6,LRA,1,LRB)) Q:LRB'>0!('$D(^(+LRB,0))#2) S Z1=^(0)
10 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."
11 I '$P(Z2,U,9),$P(Z0,U,4) D NAME1 W !,?5,"F- Test doesn't have a LAB COLLECTION SAMPLE."
12 G ATF
13NAME1 I LRPA'=LRA W !!,$P(Z0,U) S LRPA=LRA,LRPB=0
14 I LRPB'=LRB W !?2,$P(Z2,U) S LRPB=LRB
15 Q
Note: See TracBrowser for help on using the repository browser.