source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCKFLA.m@ 1258

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

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1LRCKFLA ;SLC/RWF - CHECK LOAD LIST & AUTO INSTRUMENT FILES ;2/5/91 12:32 ;
2 ;;5.2;LAB SERVICE;**272,293**;Sep 27, 1994
3 S ZTRTN="ENT^LRCKFLA" D LOG^LRCKF Q:LREND D ENT W !! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q
4ENT ;from LRCKF
5 U IO S LRDA=0
6 W !!,"CHECKING AUTO INSTRUMENT FILE"
7 F DA=0:0 S DA=$O(^LAB(62.4,DA)) Q:DA<1!(DA>98) D CHKAUTO
8 W !!,"CHECKING LOAD/WORK LIST FILE"
9 F DA=0:0 S DA=$O(^LRO(68.2,DA)) Q:DA<1 D CHKLL
10END K LRCP W !! W:$E(IOST,1,2)="P-" @IOF Q
11 Q
12NAME I LRDA'=DA W !!,$P(LA,U) S LRDA=DA
13 Q
14CHKAUTO I $D(^LAB(62.4,DA,0))[0 W !!,"F-MISSING ZERO NODE" Q
15 S LA=^LAB(62.4,DA,0),LRPGM=$P(LA,U,3)
16 I LRPGM="" D NAME W !?5,"F- Has no program name. This will prevent data processing."
17 I $L(LRPGM),$O(^LAB(62.4,"C",LRPGM,0))'=DA D NAME W !?5,"F- Has duplicate routine entry."
18 I DA#10=1,$L($P(LA,U,2))<1 D NAME W !?5,"F- SYSTEM must have a device to get the data from."
19 Q:DA#10=1
20 I $D(^LRO(68.2,+$P(LA,U,4),0))[0 D NAME W !?5,"W- Should have a LOAD/WORK LIST entry."
21 S I=0 F S I=$O(^LAB(62.4,DA,3,I)) Q:I<1 I $D(^(I,0))#2 S X=^(0) I $D(^LAB(60,+X,0))[0 D NAME W !?5,"F- Entry # ",I," has a BAD test pointer."
22 Q
23CHKLL I $D(^LRO(68.2,DA,0))[0 W !!,"F- MISSING ZERO NODE ON ENTRY: ",DA Q
24 S LA=^LRO(68.2,DA,0),LRTYPE=+$P(LA,U,3),LRNM=$P(LA,U)
25 I LRCKW,LRTYPE=0,$P(LA,U,4) D NAME W !?5,"W- A sequence/batch should have 0 for cups/tray."
26 I $P(LA,U,2),$D(^LAB(62.07,+$P(LA,U,2),0))[0 D NAME W !?5,"F- BAD pointer in the LOAD transform field."
27 ;I LRTYPE=0,$S($D(^LAB(62.07,+$P(LA,U,2),.1)):^(.1),1:"")["TRAY=" D NAME W !?5,"F - Load transform must NOT change the TRAY number."
28 I $P(LA,U,7),$D(^LAB(62.07,+$P(LA,U,7),0))[0 D NAME W !?5,"F- BAD pointer in the INITIAL setup field."
29 I $D(^LRO(68.2,DA,10,0))[0 D NAME W !?5,"W- Does not have a PROFILE definded." Q
30 F LRIX=0:0 S LRIX=$O(^LRO(68.2,DA,10,LRIX)) Q:LRIX<1 D CHKPRO S LRDA=0
31 Q
32CHKPRO I $D(^LRO(68.2,DA,10,LRIX,0))[0 D NAME W !?5,"F- MISSING PROFILE ZERO NODE." Q
33 S LA=LRNM_" profile: "_^LRO(68.2,DA,10,LRIX,0)
34 S B=1 F I=0:0 S I=$O(^LRO(68.2,DA,10,LRIX,1,I)) Q:I<1 I $D(^(I,0))#2 S X=^(0),B=(B&$P(X,U,3)) I $D(^LAB(60,+X,0))[0 D NAME W !?5,"F- has a BAD test pointer."
35 I B D NAME W !?5,"F- At least one test of the panel must NOT be build name only."
36 I $D(^LRO(68,+$P(LA,U,2),0))[0 D NAME W !?5,"F- BAD accession area pointer."
37 I LRCKW,'LRTYPE S C1=$O(^LRO(68.2,DA,10,LRIX,2,1)) I C1>0 D NAME W !?5,"W- A sequence/batch should NOT have a control TRAY ",C1," defined."
38 F T=0:0 S T=$O(^LRO(68.2,DA,10,LRIX,1,T)) Q:T'>0 F C=0:0 S C=$O(^LRO(68.2,DA,10,LRIX,1,T,1,C)) Q:C'>0 I $D(^(C,0))#2 S LRCP=+^(0) D CHKTC I A8 W " (TRAY/CUP)"
39 F C=0:0 S C=$O(^LRO(68.2,DA,10,LRIX,4,C)) Q:C'>0 I $D(^(C,0))#2 S LRCP=+^(0) D CHKCTR I A8 W " (BEGIN LIST)"
40 F C=0:0 S C=$O(^LRO(68.2,DA,10,LRIX,5,C)) Q:C'>0 I $D(^(C,0))#2 S LRCP=+^(0) D CHKCTR I A8 W " (LREND LIST)"
41 Q
42CHKTC I T#1!(C#1) D NAME W !?5,"F- TRAY AND/OR CUP must be integers."
43 Q
44CHKCTR S A8=0 I $D(^LAB(62.3,LRCP,0))[0 S A8=1 D NAME W !?5,"F- BAD control pointer." Q
45 S B=0 F J=0:0 S J=$O(^LAB(62.3,LRCP,2,J)) Q:J<1 I $D(^(J,0))#2 S T=+^(0) I $D(^LRO(68.2,DA,10,LRIX,1,"B",T)) S B=1
46 I 'B S A8=1 D NAME W !?5,"F- CONTROL: ",$P(^LAB(62.3,LRCP,0),U)," has no tests to accession for this profile."
47 Q
Note: See TracBrowser for help on using the repository browser.