- LAMIAUT4 ;SLC/FHS - EDIT OR VERIFY MICRO AUTO INSTRUMENTS; ;7/20/90 09:33
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**153**;Sep 27, 1994
- EN ;
- Q:LREND R !!," ('E'dit data, 'C'omments, 'O'rganism 'W'orklist) // ",LREDIT:DTIME Q:'$T
- I $E(LREDIT)="?" D HLP,^LAMIAUT3 G EN
- I $E(LREDIT)="^"!($E(LREDIT="@")) D DEL^LAMIAUT5 K LRBDUP,LRMOVE Q
- 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
- I $E(LREDIT)="O" S ZX9=X9 D ^LRMIBUG,^LAMIAUT3 S X9=ZX9 K ZX9 G EN
- I $E(LREDIT)="C" K DR S DR=".99;1;13" D ^DIE D ^LAMIAUT3 G EN
- I $E(LREDIT)="W" D EN^LRCAPV D ^LAMIAUT3 G EN
- R !,"Approve for release by entering your initials: ",X:DTIME I '$T!($E(X)="^") D DEL^LAMIAUT5 Q
- I X'=LRINI W !!,$C(7)," NOT APPROVED " Q
- D VER Q
- EXP ;Get the list of tests for this ACC.
- W !!,PNM," ",SSN,!,LRACCN D INF^LRX W !!?5,$P(^LAB(61,LRSPEC,0),U)," ",$P(^LAB(62,LRSAMP,0),U),!
- 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)
- 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))=""
- 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"
- V9 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
- I X["?" W !,"Enter for example 1,2,5-9." G V9
- 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
- L10 S LRNX=0 X (X9_"D EX1^LRVER1")
- Q
- EDIT 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 "
- 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
- I X["?" W !?7,"Enter for example 1,2,5-9 ",! G EDIT
- D RANGE^LRWU2 Q:X9="" X (X9_"S:'$D(LRNAME(T1)) X=0") I X=0 W !!?7,"Incorrect number ",$C(7),! G EDIT
- X (X9_"S LRTS=+$O(LRTS(T1,0)) I LRTS D EDIT1^LAMIAUT4")
- Q
- EDIT1 S LRSB=1,LRCODE=$P(^LAB(60,+$O(LRNAME(T1,0)),0),U,14) D EDIT2
- Q
- EDIT2 I 'LRCODE W $C(7),!?7,"NO EDIT CODE FOR ",LRNAME(T1) Q
- I '$D(^LAB(62.07,LRCODE,.1)) W $C(7),!?7,"EDIT CODE IS MISSING FOR ",LRNAME(T1) Q
- N LRBG0
- 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)
- I 'LRTS W !,"NO TEST DEFINED ",!!,$C(7)
- Q
- VER ;
- N LRBG0
- 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
- 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"
- F I=0:0 W !?10,"OK" S %=1 D YN^DICN Q:% W !," Enter 'Y' or 'N' : "
- I %=2!(%<0) Q
- VER1 ;
- D:'$P(^LAB(69.9,1,"NITE"),U) ANN^LRCAPV
- ;N LRADD,GLB,LRBUG,LRBUGY
- S LRSB=1 W ! X (X9_"S LRPTP=$O(LRNAME(T1,0))") S LRCAPOK=1,Y(0)=^LR(LRDFN,"MI",LRIDT,0) D
- . 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
- N LRWRDVEW
- S LRWRDVEW=1
- D VT^LRMIUT1 I $L($G(LRVT)) D STF^LRMIUT
- S ^LRO(68,"AVS",LRAA,LRAD,LRAN)=LRDFN_U_LRIDT
- K ^LAH(LRLL,1,LRIFN),^LAH(LRLL,1,"C",LRAN),^LAH(LRLL,1,"B",LRTCUP,LRIFN)
- Q
- HLP W !!?10,"ENTER",?20,"'E' TO EDIT ENTIRE ACCESSION. ",!?20,"'C' TO EDIT COMMENT",!?20,"'O' TO EDIT ORGANISM "
- W !?20,"'^' OR '@' WILL DELETE TRANSFERD DATA ",! H 2 Q
- LAMIAUT4 ;SLC/FHS - EDIT OR VERIFY MICRO AUTO INSTRUMENTS; ;7/20/90 09:33
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**153**;Sep 27, 1994
- EN ;
- +1 IF LREND
- QUIT
- READ !!," ('E'dit data, 'C'omments, 'O'rganism 'W'orklist) // ",LREDIT:DTIME
- IF '$TEST
- QUIT
- +2 IF $EXTRACT(LREDIT)="?"
- DO HLP
- DO ^LAMIAUT3
- GOTO EN
- +3 IF $EXTRACT(LREDIT)="^"!($EXTRACT(LREDIT="@"))
- DO DEL^LAMIAUT5
- KILL LRBDUP,LRMOVE
- QUIT
- +4 KILL DIC,DR,DIE,DA
- SET DA=LRIDT
- SET DA(1)=LRDFN
- SET LRY(0)=^LR(LRDFN,"MI",LRIDT,0)
- SET DIE="^LR("_DA(1)_",""MI"","
- SET DIC=DIE
- IF $EXTRACT(LREDIT)="E"
- SET ZX9=X9
- DO EDIT
- DO ^LAMIAUT3
- SET X9=ZX9
- KILL ZX9
- GOTO EN
- +5 IF $EXTRACT(LREDIT)="O"
- SET ZX9=X9
- DO ^LRMIBUG
- DO ^LAMIAUT3
- SET X9=ZX9
- KILL ZX9
- GOTO EN
- +6 IF $EXTRACT(LREDIT)="C"
- KILL DR
- SET DR=".99;1;13"
- DO ^DIE
- DO ^LAMIAUT3
- GOTO EN
- +7 IF $EXTRACT(LREDIT)="W"
- DO EN^LRCAPV
- DO ^LAMIAUT3
- GOTO EN
- +8 READ !,"Approve for release by entering your initials: ",X:DTIME
- IF '$TEST!($EXTRACT(X)="^")
- DO DEL^LAMIAUT5
- QUIT
- +9 IF X'=LRINI
- WRITE !!,$CHAR(7)," NOT APPROVED "
- QUIT
- +10 DO VER
- QUIT
- EXP ;Get the list of tests for this ACC.
- +1 WRITE !!,PNM," ",SSN,!,LRACCN
- DO INF^LRX
- WRITE !!?5,$PIECE(^LAB(61,LRSPEC,0),U)," ",$PIECE(^LAB(62,LRSAMP,0),U),!
- +2 KILL ^TMP("LR",$JOB),LRTEST,LRNAME,LRTS
- SET N=0
- FOR I=0:0
- SET I=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I))
- IF I<1
- QUIT
- SET N=N+1
- SET LRTEST(N)=+^(I,0)
- SET LRTEST(N,"P")=$PIECE(^(0),U,9)
- +3 SET LRNTN=N
- FOR I=1:1:N
- IF $DATA(^LAB(60,+LRTEST(I),0))
- SET LRTEST(I)=LRTEST(I)_U_^(0)
- SET LRNAME(I)=$PIECE(LRTEST(I),U,2)
- SET LRNAME(I,+LRTEST(I))=""
- SET LRTS(I)=LRNAME(I)
- SET LRTS(I,+LRTEST(I))=""
- +4 SET LRALL=""
- FOR I=1:1:LRNTN
- IF $DATA(LRNAME(I))
- SET LRALL=LRALL_","_I
- WRITE !,I," ",LRNAME(I)
- IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+$ORDER(LRNAME(I,0)),0))
- IF $PIECE(^(0),U,5)
- WRITE ?25," verified"
- V9 SET LRALL=$PIECE(LRALL,",",2,99)
- READ !!,"TEST #(s) (or ""ALL""): ",X:DTIME
- IF '$TEST
- SET X=U
- IF X=""
- SET X=LRALL
- IF X["A"
- SET X=LRALL
- IF $EXTRACT(X)="^"
- SET LREND=1
- IF LREND
- QUIT
- +1 IF X["?"
- WRITE !,"Enter for example 1,2,5-9."
- GOTO V9
- +2 IF $EXTRACT(X)="^"
- QUIT
- DO RANGE^LRWU2
- IF X9=""
- QUIT
- XECUTE (X9_"S:'$D(LRNAME(T1)) X=0")
- IF X=0
- WRITE !!?7,"Incorrect test number ",$CHAR(7)
- GOTO EXP
- L10 SET LRNX=0
- XECUTE (X9_"D EX1^LRVER1")
- +1 QUIT
- EDIT SET LRALL=""
- WRITE !?7,"Edit ? ",!
- FOR I=0:0
- SET I=$ORDER(LRNAME(I))
- IF I=""
- QUIT
- WRITE !?3,"(",I,") ",LRNAME(I)
- SET LRALL=LRALL_","_I
- IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$ORDER(LRNAME(I,0)),0))
- IF $PIECE(^(0),U,5)
- WRITE ?25,"Verified "
- +1 SET LRALL=$PIECE(LRALL,",",2,99)
- READ !!,"TEST #(s) (or ""ALL""): ",X:DTIME
- IF '$TEST!($EXTRACT(X)="^")
- QUIT
- IF X["A"
- SET X=LRALL
- IF X=""
- SET X=LRALL
- +2 IF X["?"
- WRITE !?7,"Enter for example 1,2,5-9 ",!
- GOTO EDIT
- +3 DO RANGE^LRWU2
- IF X9=""
- QUIT
- XECUTE (X9_"S:'$D(LRNAME(T1)) X=0")
- IF X=0
- WRITE !!?7,"Incorrect number ",$CHAR(7),!
- GOTO EDIT
- +4 XECUTE (X9_"S LRTS=+$O(LRTS(T1,0)) I LRTS D EDIT1^LAMIAUT4")
- +5 QUIT
- EDIT1 SET LRSB=1
- SET LRCODE=$PIECE(^LAB(60,+$ORDER(LRNAME(T1,0)),0),U,14)
- DO EDIT2
- +1 QUIT
- EDIT2 IF 'LRCODE
- WRITE $CHAR(7),!?7,"NO EDIT CODE FOR ",LRNAME(T1)
- QUIT
- +1 IF '$DATA(^LAB(62.07,LRCODE,.1))
- WRITE $CHAR(7),!?7,"EDIT CODE IS MISSING FOR ",LRNAME(T1)
- QUIT
- +2 NEW LRBG0
- +3 WRITE !!?7,"Editing ",LRNAME(T1),!!
- KILL DR
- SET LRTS=+$ORDER(LRTS(T1,0))
- SET (LRBG0,Y(0))=LRY(0)
- IF LRTS
- XECUTE ^LAB(62.07,LRCODE,.1)
- +4 IF 'LRTS
- WRITE !,"NO TEST DEFINED ",!!,$CHAR(7)
- +5 QUIT
- VER ;
- +1 NEW LRBG0
- +2 IF X9=""
- QUIT
- SET (LRBG0,Y(0))=^LR(LRDFN,"MI",LRIDT,0)
- SET LRCAPOK=1
- SET LRUNDO=0
- IF '$PIECE(Y(0),U,3)
- IF $PIECE(Y(0),U,9)
- SET LRUNDO=1
- GOTO VER1
- +3 IF $PIECE(^LR(LRDFN,"MI",LRIDT,0),U,3)
- WRITE !,"Final report has been verified by micro supervisor,",$CHAR(7),!,"If you proceed in editing, the report will be reprinted"
- +4 FOR I=0:0
- WRITE !?10,"OK"
- SET %=1
- DO YN^DICN
- IF %
- QUIT
- WRITE !," Enter 'Y' or 'N' : "
- +5 IF %=2!(%<0)
- QUIT
- VER1 ;
- +1 IF '$PIECE(^LAB(69.9,1,"NITE"),U)
- DO ANN^LRCAPV
- +2 ;N LRADD,GLB,LRBUG,LRBUGY
- +3 SET LRSB=1
- WRITE !
- XECUTE (X9_"S LRPTP=$O(LRNAME(T1,0))")
- SET LRCAPOK=1
- SET Y(0)=^LR(LRDFN,"MI",LRIDT,0)
- Begin DoDot:1
- +4 KILL DR
- SET DR=11
- SET LRSAME=0
- IF LRUNDO
- DO UNDO^LRMIEDZ
- DO ^DIE
- DO TIME^LRMIEDZ3
- SET LRTS=LRPTP
- IF $GET(LRTS)
- IF LRCAPOK&($PIECE(LRPARAM,U,14))
- DO LOOK^LRCAPV1
- End DoDot:1
- +5 NEW LRWRDVEW
- +6 SET LRWRDVEW=1
- +7 DO VT^LRMIUT1
- IF $LENGTH($GET(LRVT))
- DO STF^LRMIUT
- +8 SET ^LRO(68,"AVS",LRAA,LRAD,LRAN)=LRDFN_U_LRIDT
- +9 KILL ^LAH(LRLL,1,LRIFN),^LAH(LRLL,1,"C",LRAN),^LAH(LRLL,1,"B",LRTCUP,LRIFN)
- +10 QUIT
- HLP WRITE !!?10,"ENTER",?20,"'E' TO EDIT ENTIRE ACCESSION. ",!?20,"'C' TO EDIT COMMENT",!?20,"'O' TO EDIT ORGANISM "
- +1 WRITE !?20,"'^' OR '@' WILL DELETE TRANSFERD DATA ",!
- HANG 2
- QUIT
