LRMIBUG.m

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 ---LRMIBUG   3830     printed  Feb 18, 2025@23:42:50                                                                                                                                                                                                     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