source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMIAUT4.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1LAMIAUT4 ;SLC/FHS - EDIT OR VERIFY MICRO AUTO INSTRUMENTS; ;7/20/90 09:33
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**153**;Sep 27, 1994
3EN ;
4 Q:LREND R !!," ('E'dit data, 'C'omments, 'O'rganism 'W'orklist) // ",LREDIT:DTIME Q:'$T
5 I $E(LREDIT)="?" D HLP,^LAMIAUT3 G EN
6 I $E(LREDIT)="^"!($E(LREDIT="@")) D DEL^LAMIAUT5 K LRBDUP,LRMOVE Q
7 K DIC,DR,DIE,DA S DA=LRIDT,DA(1)=LRDFN,LRY(0)=^LR(LRDFN,"MI",LRIDT,0),DIE="^LR("_DA(1)_",""MI"",",DIC=DIE I $E(LREDIT)="E" S ZX9=X9 D EDIT,^LAMIAUT3 S X9=ZX9 K ZX9 G EN
8 I $E(LREDIT)="O" S ZX9=X9 D ^LRMIBUG,^LAMIAUT3 S X9=ZX9 K ZX9 G EN
9 I $E(LREDIT)="C" K DR S DR=".99;1;13" D ^DIE D ^LAMIAUT3 G EN
10 I $E(LREDIT)="W" D EN^LRCAPV D ^LAMIAUT3 G EN
11 R !,"Approve for release by entering your initials: ",X:DTIME I '$T!($E(X)="^") D DEL^LAMIAUT5 Q
12 I X'=LRINI W !!,$C(7)," NOT APPROVED " Q
13 D VER Q
14EXP ;Get the list of tests for this ACC.
15 W !!,PNM," ",SSN,!,LRACCN D INF^LRX W !!?5,$P(^LAB(61,LRSPEC,0),U)," ",$P(^LAB(62,LRSAMP,0),U),!
16 K ^TMP("LR",$J),LRTEST,LRNAME,LRTS S N=0 F I=0:0 S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1 S N=N+1,LRTEST(N)=+^(I,0),LRTEST(N,"P")=$P(^(0),U,9)
17 S LRNTN=N F I=1:1:N S:$D(^LAB(60,+LRTEST(I),0)) LRTEST(I)=LRTEST(I)_U_^(0),LRNAME(I)=$P(LRTEST(I),U,2),LRNAME(I,+LRTEST(I))="",LRTS(I)=LRNAME(I),LRTS(I,+LRTEST(I))=""
18 S LRALL="" F I=1:1:LRNTN I $D(LRNAME(I)) S LRALL=LRALL_","_I W !,I," ",LRNAME(I) I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+$O(LRNAME(I,0)),0)),$P(^(0),U,5) W ?25," verified"
19V9 S LRALL=$P(LRALL,",",2,99) R !!,"TEST #(s) (or ""ALL""): ",X:DTIME S:'$T X=U S:X="" X=LRALL S:X["A" X=LRALL S:$E(X)="^" LREND=1 Q:LREND
20 I X["?" W !,"Enter for example 1,2,5-9." G V9
21 Q:$E(X)="^" D RANGE^LRWU2 Q:X9="" X (X9_"S:'$D(LRNAME(T1)) X=0") I X=0 W !!?7,"Incorrect test number ",$C(7) G EXP
22L10 S LRNX=0 X (X9_"D EX1^LRVER1")
23 Q
24EDIT S LRALL="" W !?7,"Edit ? ",! F I=0:0 S I=$O(LRNAME(I)) Q:I="" W !?3,"(",I,") ",LRNAME(I) S LRALL=LRALL_","_I I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0)),$P(^(0),U,5) W ?25,"Verified "
25 S LRALL=$P(LRALL,",",2,99) R !!,"TEST #(s) (or ""ALL""): ",X:DTIME Q:'$T!($E(X)="^") S:X["A" X=LRALL S:X="" X=LRALL
26 I X["?" W !?7,"Enter for example 1,2,5-9 ",! G EDIT
27 D RANGE^LRWU2 Q:X9="" X (X9_"S:'$D(LRNAME(T1)) X=0") I X=0 W !!?7,"Incorrect number ",$C(7),! G EDIT
28 X (X9_"S LRTS=+$O(LRTS(T1,0)) I LRTS D EDIT1^LAMIAUT4")
29 Q
30EDIT1 S LRSB=1,LRCODE=$P(^LAB(60,+$O(LRNAME(T1,0)),0),U,14) D EDIT2
31 Q
32EDIT2 I 'LRCODE W $C(7),!?7,"NO EDIT CODE FOR ",LRNAME(T1) Q
33 I '$D(^LAB(62.07,LRCODE,.1)) W $C(7),!?7,"EDIT CODE IS MISSING FOR ",LRNAME(T1) Q
34 N LRBG0
35 W !!?7,"Editing ",LRNAME(T1),!! K DR S LRTS=+$O(LRTS(T1,0)),(LRBG0,Y(0))=LRY(0) X:LRTS ^LAB(62.07,LRCODE,.1)
36 I 'LRTS W !,"NO TEST DEFINED ",!!,$C(7)
37 Q
38VER ;
39 N LRBG0
40 Q:X9="" S (LRBG0,Y(0))=^LR(LRDFN,"MI",LRIDT,0),LRCAPOK=1,LRUNDO=0 I '$P(Y(0),U,3) S:$P(Y(0),U,9) LRUNDO=1 G VER1
41 I $P(^LR(LRDFN,"MI",LRIDT,0),U,3) W !,"Final report has been verified by micro supervisor,",$C(7),!,"If you proceed in editing, the report will be reprinted"
42 F I=0:0 W !?10,"OK" S %=1 D YN^DICN Q:% W !," Enter 'Y' or 'N' : "
43 I %=2!(%<0) Q
44VER1 ;
45 D:'$P(^LAB(69.9,1,"NITE"),U) ANN^LRCAPV
46 ;N LRADD,GLB,LRBUG,LRBUGY
47 S LRSB=1 W ! X (X9_"S LRPTP=$O(LRNAME(T1,0))") S LRCAPOK=1,Y(0)=^LR(LRDFN,"MI",LRIDT,0) D
48 . K DR S DR=11,LRSAME=0 D:LRUNDO UNDO^LRMIEDZ D ^DIE,TIME^LRMIEDZ3 S LRTS=LRPTP I $G(LRTS) D:LRCAPOK&($P(LRPARAM,U,14)) LOOK^LRCAPV1
49 N LRWRDVEW
50 S LRWRDVEW=1
51 D VT^LRMIUT1 I $L($G(LRVT)) D STF^LRMIUT
52 S ^LRO(68,"AVS",LRAA,LRAD,LRAN)=LRDFN_U_LRIDT
53 K ^LAH(LRLL,1,LRIFN),^LAH(LRLL,1,"C",LRAN),^LAH(LRLL,1,"B",LRTCUP,LRIFN)
54 Q
55HLP W !!?10,"ENTER",?20,"'E' TO EDIT ENTIRE ACCESSION. ",!?20,"'C' TO EDIT COMMENT",!?20,"'O' TO EDIT ORGANISM "
56 W !?20,"'^' OR '@' WILL DELETE TRANSFERD DATA ",! H 2 Q
Note: See TracBrowser for help on using the repository browser.