LRMIEDZ4 ;DALOI/FHS/RBN - CONTINUE MICROBIOLOGY EDIT ;11/18/11 16:04
;;5.2;LAB SERVICE;**350,461**;Sep 27, 1994;Build 15
;
; Formerly a part of LRMIEDZ2
;
EC ;
;
K LRTX
;
S LRAN=$P($P(LRBG0,U,6)," ",3),LRLLOC=$P(LRBG0,U,8),LRODT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4),LRSN=$P(^(0),U,5)
I $D(^LRO(69,+LRODT,1,+LRSN,0)) D
. S DIC="^LRO(69,"_LRODT_",1,",DA=LRSN,DR=6
. I DA>0 D EN^DIQ
;
I $D(DTOUT)!($D(DUOUT)) S LREND=1 Q
;
K LRNPTP
N LRMSTR,LRMFLG
;
S (LRI,N,LRMFLG)=0
F S LRI=+$O(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRI)) Q:LRI<.5 D
. I $P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRI,0),U,2)>49 Q
. ;notify user if a merged / cancelled test was preselected
. S LRMSTR=^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRI,0)
. I $P(LRMSTR,U,6)]"" D
. . W !,$P(^LAB(60,+LRMSTR,0),U)," ",$P(LRMSTR,U,6)
. . S LRMFLG=1
. I LRPTP>0,+LRMSTR=LRPTP D
. . I $P(LRMSTR,U,6)="*Merged" D
. . . W !," This test was merged to another accession"
. . . W !," and may not be resulted on this accession.",!
. . I $P(LRMSTR,U,6)="*Not Performed" D
. . . W !," This test may not be resulted since it is marked as ""Not Performed"".",!
. ;do not allow resulting of test which was merged / cancelled
. I $P(LRMSTR,U,6)="*Merged"!($P(LRMSTR,U,6)="*Not Performed") Q
. S N=N+1,LRTS(N)=+^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRI,0)
. S LRTX(N)=$S($P(^LAB(60,LRTS(N),0),U,14):^LAB(62.07,$P(^(0),U,14),.1),1:"")
. I LRTS(N)=LRPTP S LRNPTP=N Q
;
I LRMFLG W !
I '$D(LRNPTP),LRPTP>0 W !,"No eligible tests match with the test you preselected.",!
I $D(LRNPTP) S LRI=LRNPTP
;
I '$D(LRNPTP),N>0 F J=1:1:N D
. W !,?3,J,?8,$P(^LAB(60,LRTS(J),0),U)
. S Y=$P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS(J),0),U,5)
. I Y>0 W " Completed ",$$FMTE^XLFDT(Y,"1M")
W !
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIEDZ4 1788 printed Apr 09, 2024@21:12:17 Page 2
LRMIEDZ4 ;DALOI/FHS/RBN - CONTINUE MICROBIOLOGY EDIT ;11/18/11 16:04
+1 ;;5.2;LAB SERVICE;**350,461**;Sep 27, 1994;Build 15
+2 ;
+3 ; Formerly a part of LRMIEDZ2
+4 ;
EC ;
+1 ;
+2 KILL LRTX
+3 ;
+4 SET LRAN=$PIECE($PIECE(LRBG0,U,6)," ",3)
SET LRLLOC=$PIECE(LRBG0,U,8)
SET LRODT=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4)
SET LRSN=$PIECE(^(0),U,5)
+5 IF $DATA(^LRO(69,+LRODT,1,+LRSN,0))
Begin DoDot:1
+6 SET DIC="^LRO(69,"_LRODT_",1,"
SET DA=LRSN
SET DR=6
+7 IF DA>0
DO EN^DIQ
End DoDot:1
+8 ;
+9 IF $DATA(DTOUT)!($DATA(DUOUT))
SET LREND=1
QUIT
+10 ;
+11 KILL LRNPTP
+12 NEW LRMSTR,LRMFLG
+13 ;
+14 SET (LRI,N,LRMFLG)=0
+15 FOR
SET LRI=+$ORDER(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRI))
if LRI<.5
QUIT
Begin DoDot:1
+16 IF $PIECE(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRI,0),U,2)>49
QUIT
+17 ;notify user if a merged / cancelled test was preselected
+18 SET LRMSTR=^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRI,0)
+19 IF $PIECE(LRMSTR,U,6)]""
Begin DoDot:2
+20 WRITE !,$PIECE(^LAB(60,+LRMSTR,0),U)," ",$PIECE(LRMSTR,U,6)
+21 SET LRMFLG=1
End DoDot:2
+22 IF LRPTP>0
IF +LRMSTR=LRPTP
Begin DoDot:2
+23 IF $PIECE(LRMSTR,U,6)="*Merged"
Begin DoDot:3
+24 WRITE !," This test was merged to another accession"
+25 WRITE !," and may not be resulted on this accession.",!
End DoDot:3
+26 IF $PIECE(LRMSTR,U,6)="*Not Performed"
Begin DoDot:3
+27 WRITE !," This test may not be resulted since it is marked as ""Not Performed"".",!
End DoDot:3
End DoDot:2
+28 ;do not allow resulting of test which was merged / cancelled
+29 IF $PIECE(LRMSTR,U,6)="*Merged"!($PIECE(LRMSTR,U,6)="*Not Performed")
QUIT
+30 SET N=N+1
SET LRTS(N)=+^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRI,0)
+31 SET LRTX(N)=$SELECT($PIECE(^LAB(60,LRTS(N),0),U,14):^LAB(62.07,$PIECE(^(0),U,14),.1),1:"")
+32 IF LRTS(N)=LRPTP
SET LRNPTP=N
QUIT
End DoDot:1
+33 ;
+34 IF LRMFLG
WRITE !
+35 IF '$DATA(LRNPTP)
IF LRPTP>0
WRITE !,"No eligible tests match with the test you preselected.",!
+36 IF $DATA(LRNPTP)
SET LRI=LRNPTP
+37 ;
+38 IF '$DATA(LRNPTP)
IF N>0
FOR J=1:1:N
Begin DoDot:1
+39 WRITE !,?3,J,?8,$PIECE(^LAB(60,LRTS(J),0),U)
+40 SET Y=$PIECE(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS(J),0),U,5)
+41 IF Y>0
WRITE " Completed ",$$FMTE^XLFDT(Y,"1M")
End DoDot:1
+42 WRITE !
+43 ;
+44 QUIT
