source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRLLS.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1LRLLS ;SLC/RWF-LOAD LIST FIX UP ;8/17/87 11:16
2 ;;5.2;LAB SERVICE;**116,221**;Sep 27, 1994
3LRINST ;from LRLLS2
4 S U="^" D DT^LRX S LRAD=DT K ^TMP("LR",$J,"T"),DIC,LRHOLD,LRTSTS
5 S DIC="^LRO(68.2,",DIC(0)="AEMZ",DIC("S")="S %=$P(^(0),U,12) X ""I '$L(%)"" Q:$T S %=$P(^DIC(19.1,%,0),U,1) I $D(^XUSEC(%,DUZ))" D ^DIC K DIC S LRINST=+Y Q:Y<1
6 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)
7 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")
8 Q
9EN ;
10INSERT ;INSERT A SAMPLE ON TO A TRAY
11 D END D LRINST G END:LRINST<1 D PROFILE G END:+$G(LRWPROF)<1
12IN2 S LRACC=1 S:+$G(LRWPROF)<1 LRWPROF=0 D ^LRWU4 K LRACC G END:LRAN<1
13 D SHOW W !?15 S %=1 D YN^DICN G NOP:%<1,IN2:%=2
14 K ^TMP("LR",$J,"T"),LRTSTS D WHATEST G NOP:'$D(X),NOP:X=U
15IN5 D PCUP G NOP:LRCUP[U D LIFT,SETONE W !!," >> INSERTED <<" I LRHOLD'="" W !,"NOW WHAT TO DO WITH" D NOW,SHOW G IN5
16 Q
17LIFT K LRHOLD S LRHOLD=$S($D(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0)):^(0),1:"") Q:LRHOLD=""
18 F I=0:0 S I=$O(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,1,I)) Q:I<1 S LRHOLD(I)=^(I,0)
19 IF $D(^LRO(68,+$P(LRHOLD,U,1),1,+$P(LRHOLD,U,2),1,+$P(LRHOLD,U,3),0))[0 S LRHOLD=""
20 D DROP Q
21NOW Q:LRHOLD="" K ^TMP("LR",$J,"T"),LRTSTS S LRAA=+LRHOLD,LRAD=$P(LRHOLD,U,2),LRAN=$P(LRHOLD,U,3),LRWPROF=$P(LRHOLD,U,4)
22 W:$D(^LRO(68,LRAA,1,+LRAD,1,+LRAN,.2)) " ACCESSION: ",^(.2)
23 F I=0:0 S I=$O(LRHOLD(I)) Q:I<1 S ^TMP("LR",$J,"T",I)=LRHOLD(I)
24 Q
25PCUP S W="PUT THE SAMPLE IN " G CP1
26GCUP S W="REMOVE THE SAMPLE FROM "
27CP1 I 'LRTYPE S LRTRAY=1 W !,W,"SEQUENCE #: " R LRCUP:DTIME G CP4:LRCUP[U!(LRCUP=""),CPSH:+LRCUP'=LRCUP Q
28CP2 W !,W,"TRAY: " R LRTRAY:DTIME G CP4:LRTRAY[U!(LRTRAY="") R " CUP: ",LRCUP:DTIME G CP4:LRCUP[U!(LRCUP=""),CPTH:+LRTRAY'=LRTRAY,CPTH:+LRCUP'=LRCUP Q
29CP4 S LRCUP=U K W Q
30CPSH W !,"Enter the SEQUENCE # to use." G CP1
31CPTH W !,"Enter the TRAY or CUP that you want to use." G CP1
32EN01 ;
33CLEAR ; Clear data from LAH
34 N DIR,DIRUT,DTOUT,DUOUT,LRCNT,LRCUTDT,LREND,LRINST,LRISQN,LRCTYPE,X,Y
35 S DT=$$DT^XLFDT
36 S (LRCUTDT,LREND)=0
37 D LRINST
38 I LRINST<1 D END Q
39 I '$D(^LAH(LRINST)) D Q
40 . W !!,$C(7),"<<< No data in LAH global for this load/work list >>>",!
41 . D NOP
42 W !
43 L +^LAH(LRINST):1
44 I '$T D Q
45 . W !!,$C(7),"<<< Unable to lock global, try again later >>>",!
46 . D NOP
47 S DIR(0)="SO^0:All Results for this Load/Worklist;1:By Date Results First Received;2:By Date Results Last Updated",DIR("A")="Clear Results"
48 S DIR("?",1)="All results can be cleared or results can"
49 S DIR("?")="be cleared by date received or last updated."
50 D ^DIR
51 I $D(DIRUT) D UNLAH(LRINST),END Q
52 S LRCTYPE=+Y
53 I LRCTYPE D
54 . W !
55 . S DIR(0)="DO^:NOW:AEPTX",DIR("A")="Select Cutoff Date/Time",DIR("B")="T-1"
56 . S DIR("?",1)="Enter a date or a date/time."
57 . S DIR("?",2)="Date selected must be on or before "_$$HTE^XLFDT($H,"1")
58 . S DIR("?")="Results before this date/time will be removed from Load/Worklist "_$P($G(^LRO(68.2,+LRINST,0)),"^")_"."
59 . D ^DIR
60 . I $D(DIRUT) S LREND=1 Q
61 . S LRCUTDT=Y
62 I LREND D UNLAH(LRINST),NOP Q
63 W !
64 S DIR(0)="YO",DIR("B")="NO"
65 S DIR("A",1)="For Load/Worklist "_$P($G(^LRO(68.2,LRINST,0)),"^")_" clear "_$S(LRCUTDT:"results before "_$$FMTE^XLFDT(LRCUTDT),1:"ALL RESULTS")
66 S DIR("A")="Is this correct"
67 D ^DIR
68 I $D(DIRUT)!(Y'=1) D UNLAH(LRINST),NOP Q
69 W !!,"<< Clearing Instrument Data >>",!
70 I 'LRCUTDT K ^LAH(LRINST) ; Kill all results for this loadlist.
71 I LRCUTDT D
72 . W !,"Clearing sequence number: "
73 . S (LRCNT,LRISQN)=0
74 . F S LRISQN=$O(^LAH(LRINST,1,LRISQN)) Q:'LRISQN D
75 . . S $P(LRCNT,"^")=$P(LRCNT,"^")+1
76 . . I '$P($G(^LAH(LRINST,1,LRISQN,0)),"^",11) D UPDT^LAGEN(LRINST,LRISQN) Q ; No date, put current d/t, skip
77 . . I $P($G(^LAH(LRINST,1,LRISQN,0)),"^",9+LRCTYPE)'<LRCUTDT Q ; Skip - Keep
78 . . S LRLL=LRINST,I=LRISQN,$P(LRCNT,"^",2)=$P(LRCNT,"^",2)+1
79 . . I $X>(IOM-10) W !
80 . . W "[",LRISQN,"]"
81 . . N LRINST,LRISQN,LRCUTDT
82 . . D ZAP^LRVR3
83 . S X=$O(^LAH(LRINST,1,"A"),-1) ; Get last entry, reset zeroth node.
84 . I X S ^LAH(LRINST)=X
85 . I '$O(^LAH(LRINST,"")) K ^LAH(LRINST)
86 . W !,"Checked ",+$P(LRCNT,"^")," entries, removed ",+$P(LRCNT,"^",2),"."
87 D UNLAH(LRINST),END
88 Q
89 ;
90UNLAH(LRLL) ; Unlock node in LAH global
91 L -^LAH(+$G(LRLL))
92 Q
93 ;
94NOP W !,"Operation not complete"
95END K ^TMP("LR",$J,"T"),A,DIC,I,LRFULL,LRDFN,LRDPF,LRFULL,LRIX,LRTSTS,LRTX,LRWPROF,LRWRD,LRINSTIT,LRMAXCUP,LRTRANS,LRTYPE,X,Y,Z,LRINST,%,LRPROF,LRTRAY,LRCUP,LRAA,LRAD
96 K AGE,DFN,DOB,K,PNM,SEX,T,D,G,LRAN,LREXEC,LRLLOC,SSN,X9
97 Q
98PROFILE S DIC(0)="AEQ",DIC="^LRO(68.2,"_LRINST_",10," D ^DIC K DIC Q:Y<1
99 S LRWPROF=+Y
100 Q
101EN02 ;
102REMOVE D LRINST G NOP:LRINST<1
103RM D GCUP G END:LRCUP[U D CURRENT,DROP:%=1 W:%=1 !,">> REMOVED <<" G RM
104EN03 ;
105MOVE D LRINST G NOP:LRINST<1
106MOV D GCUP G END:LRCUP[U D LIFT I LRHOLD="" W !,"LOCATION EMPTY" G MOV
107 D NOW G IN5
108SETONE G SETONE^LRLLS2
109WHATEST G WHATEST^LRLLS2
110SHOW G SHOW^LRLLS2
111WHO G WHO^LRLLS2
112CURRENT G CURRENT^LRLLS2
113DROP G DROP^LRLLS2
114CLRALL D LRINST G CLRALL^LRLLS2
115EN04 ;
116CLRBYTRY ;CLEAR LOAD LIST BY LRTRAY
117 G CLRBYTRY^LRLLS2
Note: See TracBrowser for help on using the repository browser.