source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMILL.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1LAMILL ;SLC/DLG - BUILD LOAD LIST FOR MICROSCAN ;7/20/90 09:36 ;
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
3INSERT ;Add a sample to next cup
4 D LRINST G END:LRINST<1,END:LRDAA<1 W !,"Select only from the ",$P(^LRO(68,LRDAA,0),U)," accession area"
5 S LRACC=1 D ^LRWU4 K LRACC G FINISH:LRAN<1 I LRDAA'=LRAA W !,"Sorry but this accession is in the wrong group" G IN2
6IN2 D SHOW D WHATEST G IN7:'$D(X),FINISH:X=U
7IN5 X LRTRANS I '$D(^LRO(68.2,LRINST,1,LRTRAY,1,0)) S ^(0)="^68.22PA^^"
8 D SETONE W !!," >> ADDED <<"
9IN7 R !!,"Next Accession NUMBER: ",LRAN:DTIME G FINISH:'$T!(LRAN["^")!(LRAN'>0) I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) G IN2
10 I LRAN["?" W !,"Enter just the number part of the accession" G IN7
11 W !,$C(7),"This accesion doesn't exist" G IN7
12 Q
13NOPE W !," OPERATION NOT COMPLETE" ;Drop thru finish
14FINISH L ^LRO(68.2,LRINST) S ^LRO(68.2,LRINST,3)=0,$P(^(2),U,4,5)=LRTRAY_U_LRCUP
15END K A,DIC,I,LRDAA,LRFULL,LRDFN,LRDPF,LRFULL,LRIX,LRTSTS,LRTX,LRWPROF,LRWRD,LRINSTIT,LRMAXCUP,LRTRANS,LRTYPE,X,Y,Z,LRINST,%,LRPROF,LRTRAY,LRCUP,LRAA,LRAD
16 K AGE,DFN,DOB,K,PNM,SEX,T,D,G,LRAN,LREXEC,LRLLOC,SSN,X9
17 Q
18LRINST ;Get loadlist data
19 S U="^" D DT^LRX S LRAD=DT K ^TMP("LR",$J,"T"),DIC,LRHOLD,LRTSTS
20 S DIC="^LRO(68.2,",DIC(0)="AEMZ" D ^DIC S LRINST=+Y Q:Y<1 L ^LRO(68.2,LRINST,3)
21 I $S($D(^LRO(68.2,LRINST,3)):$P(^(3),U,1),1:0) W !,"Load list is busy now, Please try later." S LRINST=-1 L Q
22 S $P(^LRO(68.2,LRINST,3),U,1)=1 L
23 S LRTRANS=+$P(Y(0),U,2),LRTYPE=+$P(Y(0),U,3),LRFULL=$P(Y(0),U,5),LRINSTIT=+$P(Y(0),U,7),LRMAXCUP=+$P(Y(0),U,4),Y(2)=$S($D(^LRO(68.2,LRINST,2)):^(2),1:""),LRTRAY=+$P(Y(2),U,4),LRCUP=+$P(Y(2),U,5)
24 S LRTRANS=$S($D(^LAB(62.07,LRTRANS,.1)):^(.1),1:"S LRCUP=LRCUP+1"),LRINSTIT=$S($D(^LAB(62.07,LRINSTIT,.1)):^(.1),1:"Q")
25 S:'LRTYPE LRTRAY=1 S LRWPROF=+$O(^LRO(68.2,LRINST,10,0)),LRDAA=$S($D(^LRO(68.2,LRINST,10,LRWPROF,0)):$P(^(0),U,2),1:0)
26 S ^LRO(68.2,LRINST,1,0)="^68.21^"_LRTRAY_U_LRTRAY,^(LRTRAY,0)=LRTRAY_U_DT_U_DUZ_U_LRDAA
27 Q
28SETONE ;Set tests into cup and update accession
29 S ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0)=LRAA_U_LRAD_U_LRAN_U_LRWPROF_U_LRSPEC
30 F I=0:0 S I=$O(X(I)) Q:I="" S LRIX=G2(I),LRTX=G2(I,0) D MV2
31 K DR,DIE S DA=LRCUP,DA(1)=LRTRAY,DA(2)=LRINST,DR="5//^S X=1",DR(2,68.225)="1//^S X=1",DIE="^LRO(68.2,LRINST,1,LRTRAY,1," D ^DIE
32 Q
33MV2 S ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,1,LRIX,0)=LRTX,$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRIX,0),U,3)=LRINST_";"_LRTRAY_";"_LRCUP
34 Q
35WHATEST ;
36 S LRSPEC=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)):+^(0),1:"")
37 K X,G2 S G2=0 F I=0:0 S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1 I +^(I,0),'$P(^(0),U,3) S G2=G2+1,G2(G2)=I,G2(G2,0)=+^(0)
38 I G2<1 W !,"NO TESTS FREE TO ADD" K G2 Q
39 S G4="$P(^LAB(60,+G2(I,0),0),U,1)",G1="What test(s) to add?" D GROUP^LRWU2
40 Q
41SHOW ;Show the patient
42 S LRDFN=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)):+^(0),1:-1) Q:LRDFN<1 S X=^LR(LRDFN,0)
43 S LRDPF=$P(X,U,2),DFN=$P(X,U,3) D PT^LRX W !,PNM,?40,SSN Q
44 Q
Note: See TracBrowser for help on using the repository browser.