| 1 | LAMIAUT2 ;SLC/FHS - CONTINUE MICRO AUTO INSTRUMENT PROGRAM VITEK ;7/20/90 09:33 ;
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | K LRMOVE,LRCNODE,LRORG
|
|---|
| 5 | S LRTS=+$O(LRTS(+$G(T1),0)) I 'LRTS W !!,"NO TEST DEFINED",!!,$C(7) Q
|
|---|
| 6 | S LRORG=0 F I=0:0 S I=$O(^LAH(LRLL,1,LRIFN,3,I)) Q:I="" I $D(^(I,0)) S LRORG(+^(0))=I D COM K LR6331
|
|---|
| 7 | D COM2,COM^LAMIAUT6 K LR6333 S LREND=0 F IR=0:0 S IR=$O(^LAH(LRLL,1,LRIFN,3,IR)) Q:LREND!(IR="") I $D(^(IR,0)) S (LRORGN,X)=+^(0) I X,'$D(LRMOVE(IR)) D NEXT,MOVE
|
|---|
| 8 | I $D(^LAH(LRLL,1,LRIFN,4,0)) S %X="^LAH("_LRLL_",1,"_LRIFN_",4,",%Y="^LR("_LRDFN_",""MI"","_LRIDT_",4," D %XY^%RCR
|
|---|
| 9 | S $P(^LR(LRDFN,"MI",LRIDT,1),U,3)=DUZ Q
|
|---|
| 10 | MOVE ;Move data into ^LR(LRDFN,"MI",LRIDT,3,
|
|---|
| 11 | I LREND S LREND=0,^LAH(LRLL,1,LRIFN,3,IR,0)=LRCNODE K LRMOVE(IR) Q
|
|---|
| 12 | I IR'=LRORG S %X="^LAH("_LRLL_",1,"_LRIFN_",3,"_IR_",",%Y="^LAH("_LRLL_",1,"_LRIFN_",3,"_LRORG_"," D %XY^%RCR K ^LAH(LRLL,1,LRIFN,3,IR)
|
|---|
| 13 | S %X="^LAH("_LRLL_",1,"_LRIFN_",3,"_LRORG_",",%Y="^LR("_LRDFN_",""MI"","_LRIDT_",3,"_LRORG_"," D %XY^%RCR
|
|---|
| 14 | S ^LAH(LRLL,1,LRIFN,3,LRORG,0)=LRCNODE
|
|---|
| 15 | Q
|
|---|
| 16 | NEXT ;
|
|---|
| 17 | S LREND=0 D ^LAMIAUT6 Q:LREND I $D(LRBDUP(X)) D DUP^LAMIAUT6 Q
|
|---|
| 18 | I '$D(^LR(LRDFN,"MI",LRIDT,3,IR)) S LRMOVE(IR)="A",LRORG=IR,$P(^(0),U,3)=IR,$P(^(0),U,4)=$P(^(0),U,4)+1 Q
|
|---|
| 19 | F II=1:1 Q:'$D(^LR(LRDFN,"MI",LRIDT,3,II))&('$D(^LAH(LRLL,1,LRIFN,3,II)))
|
|---|
| 20 | S LRMOVE(II)="A",LRORG=II,$P(^LR(LRDFN,"MI",LRIDT,3,0),U,3)=LRORG,$P(^(0),U,4)=$P(^(0),U,4)+1
|
|---|
| 21 | Q
|
|---|
| 22 | ORG ;
|
|---|
| 23 | S LRORG=+$S($D(^LAH(LRLL,1,LRIFN,3,II,0)):^(0),1:0),LRORGN=$S($D(^LAB(61.2,LRORG,0)):$P(^(0),U),1:"")
|
|---|
| 24 | I 'LRORG K ^LAH(LRLL,1,LRIFN,3,II)
|
|---|
| 25 | I '$L(LRORGN) W !!,$C(7),LRORG_" IS NOT IN THE ETIOLOGY FILE #61.2 " K ^LAH(LRLL,1,LRIFN,3,II) Q
|
|---|
| 26 | ASK ;
|
|---|
| 27 | K X2 I $L($P(^LAH(LRLL,1,LRIFN,3,II,0),U,2)) S X2=$P(^(0),U,2)
|
|---|
| 28 | S LREND=0 W !!,"ENTER QUANTITY FOR ( "_LRORGN_" ) : ",$S($D(X2):X2_" // ",1:" ") R X:DTIME S:'$T!($E(X)="^") LREND=1 Q:LREND I $D(X2),'$L(X),X'="@" S X=X2
|
|---|
| 29 | S:$E(X)="^" LREND=1 Q:LREND I X="@" S $P(^LAH(LRLL,1,LRIFN,3,II,0),U,2)="" Q
|
|---|
| 30 | I $E(X)="?" W !?7,"Enter 2-68 characters or a Lab Description" K DIC S X="?",DIC="^LAB(62.5,",DIC(0)="Q",DIC("S")="I LRMICOMS[$P(^(0),U,4)" D ^DIC K DIC G ASK
|
|---|
| 31 | I $L(X) X LRMICOM I '$D(X) W !?7,"Enter 2-68 characters " G ASK
|
|---|
| 32 | I $L(X) W !,X_" " S %=1 D YN^DICN G:%'=1 ASK I $L(X) S $P(^LAH(LRLL,1,LRIFN,3,II,0),U,2)=X
|
|---|
| 33 | Q
|
|---|
| 34 | COM ;Set descriptor block for comments
|
|---|
| 35 | S LR6331=$O(^LAH(LRLL,1,LRIFN,3,I,1,0)) I LR6331 S ^(0)="^63.31A^"_LR6331_"^1" F LR6331=LR6331:0 S LR6331=$O(^(LR6331)) Q:LR6331="" S $P(^(0),U,3)=LR6331,$P(^(0),U,4)=$P(^(0),U,4)+1
|
|---|
| 36 | Q
|
|---|
| 37 | COM2 ;Set descriptor block for remarks
|
|---|
| 38 | S LR6333=$O(^LAH(LRLL,1,LRIFN,4,0)) I LR6333 S ^(0)="^63.33A^"_LR6333_"^1" F LR6333=LR6333:0 S LR6333=$O(^(LR6333)) Q:LR6333="" S $P(^(0),U,3)=LR6333,$P(^(0),U,4)=$P(^(0),U,4)+1
|
|---|
| 39 | Q
|
|---|
