LRMIBUG ;DALOI/JMC- DISPLAY ORGANISMS ;07/15/09 10:38
;;5.2;LAB SERVICE;**318,321,339,350,536**;Sep 27, 1994;Build 18
;
; Reference to ^DIE global supported by ICR #5002
;
BUGS ;
Q:$G(LREND)
N LR1PASS,LRBG,LRBI,LRBG1
D KVAR^VADPT
S LR1PASS=1
I '$D(^LR(LRDFN,"MI",LRIDT,3,"B")) D SETBINDX^LRMIBUG(LRDFN,LRIDT,3)
F D BUGIN Q:Y<1 S LRBG1=Y(0) D:$P(Y,U,3)&($P(LRPARAM,U,14))&($P($G(^LRO(68,LRAA,0)),U,16)) ETIO^LRCAPV1 D BUGGER,BUGOUT
D BUGOUT
;
Q
;
;
BUGIN ;
S DIC=DIE_DA_",3,",LRODA=DA,LRODIE=DIE,DA(1)=DA,DA(2)=LRDFN
S DIC(0)="AEFLMOQZ"
S DIC("S")="I 1 Q:$D(^LR(DA(2),""MI"",DA(1),3,+X)) Q:'$D(^LAB(61.2,+X,0)) I $L($P(^(0),U,5)),""PVRBFM""[$P(^(0),U,5)"
S:'$D(@(DIC_"0)")) ^(0)="^63.3PA" S LRSPEC=$P(^LR(LRDFN,"MI",LRIDT,0),U,5)
W ! S LRBG=0
F S LRBG=$O(^LR(LRDFN,"MI",DA,3,LRBG)) Q:LRBG<1 S LRBUG=+^(LRBG,0) K DIC("B") S:LRBG=1&LR1PASS DIC("B")=$P(^LAB(61.2,+^LR(LRDFN,"MI",DA,3,1,0),0),U) W !?2,LRBG,?5,$P(^LAB(61.2,LRBUG,0),U)
S DLAYGO=63 D ^DIC
K DIC("B"),DIC("S"),DLAYGO
S LR1PASS=0
Q
;
;
BUGGER ;
S LRNB=$S($L($P(^LAB(61.2,+LRBG1,0),U,4)):$P(^(0),U,4),1:LRMIDEF),LRBI=$P(^(0),U,5)
N LRTHISDA
S DIE=DIC,DA=+Y,LRTHISDA=DA D TEMP,^DIE,DELINT I '$D(Y) Q
;
;added for LR*5.2*536
;If the session times out while entering organism and/or sensitivity
;(antibiotic) results, the results are not filed into the LAB DATA
;(#63) file. The root cause is that TR^DIED sets variable DTOUT to
;"^" if a timeout occurs during the execution of an input template.
;RE+1^DIED then invokes "I $D(DTOUT) K DQ,DG G QY^DIE1" which causes
;the DIE* logic to not file the results. Further tracing was not
;performed in the DIE* code.
;
;$G(DTOUT) = session possibly timed out without DTOUT set to "^"
;$G(DTOUT)="^" = session timed out while entering organism and/or
; sensitivities
;
I $G(DTOUT)!($G(DTOUT)="^") D Q
. W !!,"**** WARNING ****"
. W !,"Your session has timed out. Organism and/or antibiotic"
. W !,"results need to be re-entered."
. W !,"Verify all results on this accession are correct."
. N DIR
. S DIR(0)="E"
. S DIR("A")="Press enter to continue"
. D ^DIR
. D BUGOUT
. F D BUGIN Q:Y<1 D
. . S LRBG1=Y(0)
. . D:$P(Y,U,3)&($P(LRPARAM,U,14))&($P($G(^LRO(68,LRAA,0)),U,16)) ETIO^LRCAPV1
. . D BUGGER,BUGOUT
;end of LR*5.2*536 changes
W !,"Any other antibiotics" S %=2 D YN^DICN I %'=1 Q
I '$L(LRMIOTH) S DR="S Y=200;2.0000001:200",DR(2,63.32)=.01 D ^DIE Q
K DR
S LRNB=LRMIOTH D TEMP F J=1:1 S K=$P(DR,";",J) Q:+K'=K!(K>2)!'$L(K)
S (DR,DR(1,63.3))=$P(DR,";",J,245)
D ^DIE
Q
;
;
TEMP ;
S LRNB=+$O(^DIE("B",$S($L(LRNB):LRNB,1:0),0))
I LRNB,$D(^DIE(LRNB,"DR",3,63.3)) S (DR,DR(1,63.3))=^(63.3),J=0 F I=0:0 S J=$O(^DIE(LRNB,"DR",3,63.3,J)) Q:J<1 S DR(1,63.3,J)=^(J)
I 'LRNB!('$D(^DIE(LRNB,"DR",3,63.3))) S DR=$S(($L(LRBI)&("MFBVRP"[LRBI)):".01;1;2",1:".01;1;2:195")
Q
;
;
BUGOUT ;
S (DIE,DIC)=LRODIE,DA=LRODA,DA(1)=LRDFN K DR(1,63.3)
Q
;
;
DELINT ; If a Result is (1st piece) deleted in ^LR(LRDFN,"MI",LRIDT,3
; the associated Interpretation (2nd piece) should be deleted
; as well. If S^S^ exists, and the Result is deleted, ^S^ Interpretation remains.
; This process will clean up the remaining Interpretation
Q:'LRDFN!('LRIDT)!('LRTHISDA)
N LRXX
S LRXX=2 ;This node bumps in fractions exp. 2.001 2.00234
F S LRXX=$O(^LR(LRDFN,"MI",LRIDT,3,LRTHISDA,LRXX)) Q:'LRXX!(LRXX'<3) D
. I $P(^LR(LRDFN,"MI",LRIDT,3,LRTHISDA,LRXX),U)="" S $P(^LR(LRDFN,"MI",LRIDT,3,LRTHISDA,LRXX),U,2)=""
Q
;
;
SETBINDX(LRDFN,LRIDT,LRNODE) ; Set "B" x-ref if "B" x-ref doesn't exist on #.01 field.
N DA,DIC,DIE,DIK,DLAYGO,DR,X,Y
S DA(1)=LRIDT,DA(2)=LRDFN
S DIK="^LR("_LRDFN_",""MI"","_LRIDT_","_LRNODE_","
S DIK(1)=".01^B"
D ENALL^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIBUG 3830 printed Oct 16, 2024@18:17:42 Page 2
LRMIBUG ;DALOI/JMC- DISPLAY ORGANISMS ;07/15/09 10:38
+1 ;;5.2;LAB SERVICE;**318,321,339,350,536**;Sep 27, 1994;Build 18
+2 ;
+3 ; Reference to ^DIE global supported by ICR #5002
+4 ;
BUGS ;
+1 if $GET(LREND)
QUIT
+2 NEW LR1PASS,LRBG,LRBI,LRBG1
+3 DO KVAR^VADPT
+4 SET LR1PASS=1
+5 IF '$DATA(^LR(LRDFN,"MI",LRIDT,3,"B"))
DO SETBINDX^LRMIBUG(LRDFN,LRIDT,3)
+6 FOR
DO BUGIN
if Y<1
QUIT
SET LRBG1=Y(0)
if $PIECE(Y,U,3)&($PIECE(LRPARAM,U,14))&($PIECE($GET(^LRO(68,LRAA,0)),U,16))
DO ETIO^LRCAPV1
DO BUGGER
DO BUGOUT
+7 DO BUGOUT
+8 ;
+9 QUIT
+10 ;
+11 ;
BUGIN ;
+1 SET DIC=DIE_DA_",3,"
SET LRODA=DA
SET LRODIE=DIE
SET DA(1)=DA
SET DA(2)=LRDFN
+2 SET DIC(0)="AEFLMOQZ"
+3 SET DIC("S")="I 1 Q:$D(^LR(DA(2),""MI"",DA(1),3,+X)) Q:'$D(^LAB(61.2,+X,0)) I $L($P(^(0),U,5)),""PVRBFM""[$P(^(0),U,5)"
+4 if '$DATA(@(DIC_"0)"))
SET ^(0)="^63.3PA"
SET LRSPEC=$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,5)
+5 WRITE !
SET LRBG=0
+6 FOR
SET LRBG=$ORDER(^LR(LRDFN,"MI",DA,3,LRBG))
if LRBG<1
QUIT
SET LRBUG=+^(LRBG,0)
KILL DIC("B")
if LRBG=1&LR1PASS
SET DIC("B")=$PIECE(^LAB(61.2,+^LR(LRDFN,"MI",DA,3,1,0),0),U)
WRITE !?2,LRBG,?5,$PIECE(^LAB(61.2,LRBUG,0),U)
+7 SET DLAYGO=63
DO ^DIC
+8 KILL DIC("B"),DIC("S"),DLAYGO
+9 SET LR1PASS=0
+10 QUIT
+11 ;
+12 ;
BUGGER ;
+1 SET LRNB=$SELECT($LENGTH($PIECE(^LAB(61.2,+LRBG1,0),U,4)):$PIECE(^(0),U,4),1:LRMIDEF)
SET LRBI=$PIECE(^(0),U,5)
+2 NEW LRTHISDA
+3 SET DIE=DIC
SET DA=+Y
SET LRTHISDA=DA
DO TEMP
DO ^DIE
DO DELINT
IF '$DATA(Y)
QUIT
+4 ;
+5 ;added for LR*5.2*536
+6 ;If the session times out while entering organism and/or sensitivity
+7 ;(antibiotic) results, the results are not filed into the LAB DATA
+8 ;(#63) file. The root cause is that TR^DIED sets variable DTOUT to
+9 ;"^" if a timeout occurs during the execution of an input template.
+10 ;RE+1^DIED then invokes "I $D(DTOUT) K DQ,DG G QY^DIE1" which causes
+11 ;the DIE* logic to not file the results. Further tracing was not
+12 ;performed in the DIE* code.
+13 ;
+14 ;$G(DTOUT) = session possibly timed out without DTOUT set to "^"
+15 ;$G(DTOUT)="^" = session timed out while entering organism and/or
+16 ; sensitivities
+17 ;
+18 IF $GET(DTOUT)!($GET(DTOUT)="^")
Begin DoDot:1
+19 WRITE !!,"**** WARNING ****"
+20 WRITE !,"Your session has timed out. Organism and/or antibiotic"
+21 WRITE !,"results need to be re-entered."
+22 WRITE !,"Verify all results on this accession are correct."
+23 NEW DIR
+24 SET DIR(0)="E"
+25 SET DIR("A")="Press enter to continue"
+26 DO ^DIR
+27 DO BUGOUT
+28 FOR
DO BUGIN
if Y<1
QUIT
Begin DoDot:2
+29 SET LRBG1=Y(0)
+30 if $PIECE(Y,U,3)&($PIECE(LRPARAM,U,14))&($PIECE($GET(^LRO(68,LRAA,0)),U,16))
DO ETIO^LRCAPV1
+31 DO BUGGER
DO BUGOUT
End DoDot:2
End DoDot:1
QUIT
+32 ;end of LR*5.2*536 changes
+33 WRITE !,"Any other antibiotics"
SET %=2
DO YN^DICN
IF %'=1
QUIT
+34 IF '$LENGTH(LRMIOTH)
SET DR="S Y=200;2.0000001:200"
SET DR(2,63.32)=.01
DO ^DIE
QUIT
+35 KILL DR
+36 SET LRNB=LRMIOTH
DO TEMP
FOR J=1:1
SET K=$PIECE(DR,";",J)
if +K'=K!(K>2)!'$LENGTH(K)
QUIT
+37 SET (DR,DR(1,63.3))=$PIECE(DR,";",J,245)
+38 DO ^DIE
+39 QUIT
+40 ;
+41 ;
TEMP ;
+1 SET LRNB=+$ORDER(^DIE("B",$SELECT($LENGTH(LRNB):LRNB,1:0),0))
+2 IF LRNB
IF $DATA(^DIE(LRNB,"DR",3,63.3))
SET (DR,DR(1,63.3))=^(63.3)
SET J=0
FOR I=0:0
SET J=$ORDER(^DIE(LRNB,"DR",3,63.3,J))
if J<1
QUIT
SET DR(1,63.3,J)=^(J)
+3 IF 'LRNB!('$DATA(^DIE(LRNB,"DR",3,63.3)))
SET DR=$SELECT(($LENGTH(LRBI)&("MFBVRP"[LRBI)):".01;1;2",1:".01;1;2:195")
+4 QUIT
+5 ;
+6 ;
BUGOUT ;
+1 SET (DIE,DIC)=LRODIE
SET DA=LRODA
SET DA(1)=LRDFN
KILL DR(1,63.3)
+2 QUIT
+3 ;
+4 ;
DELINT ; If a Result is (1st piece) deleted in ^LR(LRDFN,"MI",LRIDT,3
+1 ; the associated Interpretation (2nd piece) should be deleted
+2 ; as well. If S^S^ exists, and the Result is deleted, ^S^ Interpretation remains.
+3 ; This process will clean up the remaining Interpretation
+4 if 'LRDFN!('LRIDT)!('LRTHISDA)
QUIT
+5 NEW LRXX
+6 ;This node bumps in fractions exp. 2.001 2.00234
SET LRXX=2
+7 FOR
SET LRXX=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRTHISDA,LRXX))
if 'LRXX!(LRXX'<3)
QUIT
Begin DoDot:1
+8 IF $PIECE(^LR(LRDFN,"MI",LRIDT,3,LRTHISDA,LRXX),U)=""
SET $PIECE(^LR(LRDFN,"MI",LRIDT,3,LRTHISDA,LRXX),U,2)=""
End DoDot:1
+9 QUIT
+10 ;
+11 ;
SETBINDX(LRDFN,LRIDT,LRNODE) ; Set "B" x-ref if "B" x-ref doesn't exist on #.01 field.
+1 NEW DA,DIC,DIE,DIK,DLAYGO,DR,X,Y
+2 SET DA(1)=LRIDT
SET DA(2)=LRDFN
+3 SET DIK="^LR("_LRDFN_",""MI"","_LRIDT_","_LRNODE_","
+4 SET DIK(1)=".01^B"
+5 DO ENALL^DIK
+6 QUIT
