LRWU8 ;DALOI/WPW - TOOL TO FIX ORGANISM SUBFILE AND DATA ;06/06/12 16:06
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
;Reference to ^DD supported by ICR# 29 and 999
;---------------------------------------------------------------
;
;Output:
;-------
; ^TMP("LR",$J,scenario [for email/report]
;
; scenario Description
; -------- -----------------------------------------------------
; S1........Bad Input Transform found.
; S2........Bad Help Text found.
; S3........Bad Key found.
; S4........Field number is good (ien) so build sensitivity,
; interp & screen definition based on good field
; number, no result data needs updating.
; S5........Field number is bad (ien) so delete bad definitions,
; build new sensitivity, interp & screen definitions
; and update results data as needed.
; S6........Everything left over that could not be
; programmatically corrected.
;
;---------------------------------------------------------------
EN ; Interactive entry point.
;
N FIX,INSTALL,LR,LRSITE,LRSUBFIL,LRTYPE,NBR,TSTR,XMDUZ,XMY
;
I '$D(^XUSEC("LRLIASON",DUZ)) D Q
.W !,"You do not have the LRLIASON key which is required to"
.W " run this tool.",*7
;
S FIX=$$ASK^LRWU8A(),INSTALL=0
;
I 'FIX Q
;
S FIX=FIX-1 ;FIX=0: Analyze, FIX=1: Analyze and Fix.
;
S XMDUZ=DUZ,XMY(DUZ)=""
D DES^XMA21 ; call to get the email recipients list.
;
D PREP^XGF ; setup screen
;
D INIT,SORT,DISCARD,ANALYZE,FIX0,FIX5,FIX1,FIX2,FIX3,FIX4
D SEND^LRWU8A ; send email/report
D CLEAN^XGF ; reset screen
;
K ^TMP(LR,$J)
;
Q
;---------------------------------------------------------------
KIDS ; Entry point for post install run.
;
N FIX,INSTALL,LR,LRSITE,LRSUBFIL,LRTYPE,NBR,XMY
;
I $$PROD^XUPROD(),$G(^XMB("NETNAME"))["DOMAIN.EXT" S XMY("G.LAB DEV IRMFO@DOMAIN.EXT")="",XMY("G.CSCLIN4@DOMAIN.EXT")=""
S XMY(DUZ)="",XMY("G.LMI")="",FIX=0,INSTALL=1 ;[ccr-8167]
;
D INIT,SORT,DISCARD,ANALYZE,FIX0,FIX5,FIX1,FIX2,FIX3,FIX4
D SEND^LRWU8A ; send email/report
;
K ^TMP(LR,$J)
;
Q
;---------------------------------------------------------------
LRNIGHT ; Entry point for ^LRNIGHT run.
;
N FIX,INSTALL,LR,LRSITE,LRSUBFIL,LRTYPE,NBR,XMY
;
I $$PROD^XUPROD(),$G(^XMB("NETNAME"))["DOMAIN.EXT" S XMY("G.LAB DEV IRMFO@DOMAIN.EXT")="",XMY("G.CSCLIN4@DOMAIN.EXT")=""
S (XMY(DUZ),XMY("G.LMI"))="",FIX=0,INSTALL=1
;
D INIT,SORT,DISCARD,ANALYZE,FIX0,FIX5,FIX1,FIX2,FIX3,FIX4
I $D(^TMP(LR,$J)) D SEND^LRWU8A ; send email/report
;
K ^TMP(LR,$J)
;
Q
;---------------------------------------------------------------
INIT ; Initialize variables and such...
;
D DT^DICRW ; load fileman variables.
;
S LRTYPE=1,LR="LR",LRSITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))
S NBR="2.00"_LRSITE,LRSUBFIL=63.3,DT=$$DT^XLFDT
;
; Ignore fields inadvertently distributed by a previous Lab patch from
; a development account to some VA sites during patch testing.
; These fields were name spaced under site number 170 and 600.
S TSTR=""
I $E(LRSITE,1,3)'=170 S TSTR=TSTR_"|2.00170001|2.00170002|2.00170003|2.00170004|2.00170005"
I $E(LRSITE,1,3)'=600 S TSTR=TSTR_"|2.00600001|2.00600002|2.00600003|2.00600004|2.00600005|2.00600006|2.00600007"
S TSTR=TSTR_"|"
;
K ^TMP(LR,$J)
;
Q
;---------------------------------------------------------------
SORT ; Sort Antibiotics fields: 1-Sensitivity, 2-Interp & 3-Screen.
;
; Input: None.
;
;Output: ^TMP(LR,$j,"SORT", = field number sort + 1, 2 and/or 3
; ^TMP(LR,$j,"S1",ien) = bad input transform
; ^TMP(LR,$j,"S2",ien) = bad help text
; ^TMP(LR,$j,"S3",ien) = bad key
;-----
N D0,DATA,HELP,IT,KEY,NKEY
;
S NKEY="A:ALWAYS DISPLAY;N:NEVER DISPLAY;R:RESTRICT DISPLAY;"
;
S D0=""
F S D0=$O(^DD(63.3,D0)) Q:D0="" D:$D(^DD(63.3,D0,0))
.S DATA=$G(^DD(63.3,D0,0)) Q:DATA=""
.I +$P(DATA,U,4)<2 Q
.I +$P(DATA,U,4)>2.99999999 Q
.S IT=$P(DATA,U,5,99),HELP=$G(^DD(63.3,D0,4)),KEY=$P(DATA,U,3)
.I $P($P(DATA,U,4),";",2)=1 D
..I IT'="D ^LRMISR" D
...S ^TMP(LR,$J,"S1",D0)=IT_"|D ^LRMISR"
..I HELP'="D EN^LRMISR" D
...S ^TMP(LR,$J,"S2",D0)=HELP_"|D EN^LRMISR"
.I $P($P(DATA,U,4),";",2)=2 D
..I IT'="D INT^LRMISR" D
...S ^TMP(LR,$J,"S1",D0)=IT_"|D INT^LRMISR"
..I HELP'="D HINT^LRMISR" D
...S ^TMP(LR,$J,"S2",D0)=HELP_"|D HINT^LRMISR"
.I $P($P(DATA,U,4),";",2)=3 D
..I IT'="Q" D
...S ^TMP(LR,$J,"S1",D0)=IT_"|Q"
..I KEY'=NKEY D
...S ^TMP(LR,$J,"S3",D0)=KEY_"|"_NKEY
.S ^TMP(LR,$J,"SORT",+$P(DATA,U,4),$P($P(DATA,U,4),";",2))=D0
;
Q
;---------------------------------------------------------------
DISCARD ; Discard Antibiotic if all 3 tests are defined.
;
; Input: ^TMP(LR,$J,"SORT"
;
;Output: ^TMP(LR,$J,"SORT"
;-----
N CNT,DATA,LRX,LRFLD
;
S (LRX,LRFLD)=""
F S LRFLD=$O(^TMP(LR,$J,"SORT",LRFLD)) Q:LRFLD="" D
.F CNT=0:1 S LRX=$O(^TMP(LR,$J,"SORT",LRFLD,LRX)) Q:LRX="" D
..S DATA=^TMP(LR,$J,"SORT",LRFLD,LRX)
.;
.; Ignore fields inadvertently distributed by a previous Lab patch from
.; a development account to some VA sites during patch testing.
.; These fields were name spaced under site number 170 and 600.
.I CNT=3,TSTR'[("|"_LRFLD_"|") K ^TMP(LR,$J,"SORT",LRFLD) Q
.S ^TMP(LR,$J,"SORT",LRFLD)=CNT_U_DATA
;
Q
;---------------------------------------------------------------
ANALYZE ; Check ^LR for entries after discard.
;
; Input: ^TMP(LR,$J,"SORT"
;
;Output: ^TMP(LR,$J,"CNT",LRFLD = total result entries for ien
;-----
I '$D(^TMP(LR,$J,"SORT")) Q
;
N CNT,D2,LRFLD,LRDFN,LRIDT
;
S (LRDFN,LRIDT,D2,LRFLD)=""
F CNT=1:1 S LRDFN=$O(^LR(LRDFN)) Q:LRDFN="" D
.I 'INSTALL D
..I (CNT#1000)=1 D SAY^XGF(24,1,"Analyzing LRDFN: "_LRDFN)
.I '$D(^LR(LRDFN,"MI")) Q
.F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT="" D
..I '$D(^LR(LRDFN,"MI",LRIDT,3)) Q
..F S D2=$O(^LR(LRDFN,"MI",LRIDT,3,D2)) Q:D2="" D
...F S LRFLD=$O(^TMP(LR,$J,"SORT",LRFLD)) Q:LRFLD="" D
....I '$D(^LR(LRDFN,"MI",LRIDT,3,D2,LRFLD)) Q
....S ^TMP(LR,$J,"CNT",LRFLD)=$G(^TMP(LR,$J,"CNT",LRFLD))+1
;
Q
;---------------------------------------------------------------
FIX0 ; Cleanup non data leftover fields from previous patches.
;
; Input: ^TMP(LR,$J,"SORT"
;
;Output: None
;-----
I '$D(^TMP(LR,$J,"SORT")) Q
;
N CNT,DA,DIK,LRFLD,LRTNODE,PCE
;
F PCE=2:1 S LRFLD=$P(TSTR,"|",PCE) Q:LRFLD="" D
.I +$G(^TMP(LR,$J,"CNT",LRFLD)) D Q
..I +$G(^TMP(LR,$J,"SORT",LRFLD))=3 D
...K ^TMP(LR,$J,"SORT",LRFLD),^TMP(LR,$J,"CNT",LRFLD)
.;
.F CNT=1:1:3 I $D(^TMP(LR,$J,"SORT",LRFLD,CNT)) D
..S DA=^TMP(LR,$J,"SORT",LRFLD,CNT)
..S DA(1)=LRSUBFIL,DIK="^DD("_DA(1)_","
..I FIX D ^DIK
..F LRTNODE="S1","S2","S3" K ^TMP(LR,$J,LRTNODE,DA)
.;
.K ^TMP(LR,$J,"SORT",LRFLD)
;
Q
;---------------------------------------------------------------
FIX1 ; Cleanup the bad Input Transforms, Help Text and Input Keys.
;
; Input: ^TMP(LR,$J,"S1" <= input transforms
; ^TMP(LR,$J,"S2" <= help text
; ^TMP(LR,$J,"S3" <= input keys
;
;Output: None
;-----
I 'FIX Q
I '$D(^TMP(LR,$J,"S1")),'$D(^TMP(LR,$J,"S2")),'$D(^TMP(LR,$J,"S3")) Q
;
N DATA,LRFLD,NEW
;
S LRFLD=""
F S LRFLD=$O(^TMP(LR,$J,"S1",LRFLD)) Q:LRFLD="" D
.S DATA=^DD(63.3,LRFLD,0),NEW=$P(^TMP(LR,$J,"S1",LRFLD),"|",2)
.S ^DD(63.3,LRFLD,0)=$P(DATA,U,1,4)_U_NEW
.S ^DD(63.3,LRFLD,"DT")=DT
;
F S LRFLD=$O(^TMP(LR,$J,"S2",LRFLD)) Q:LRFLD="" D
.S ^DD(63.3,LRFLD,4)=$P(^TMP(LR,$J,"S2",LRFLD),"|",2)
.S ^DD(63.3,LRFLD,"DT")=DT
;
F S LRFLD=$O(^TMP(LR,$J,"S3",LRFLD)) Q:LRFLD="" D
.S DATA=^DD(63.3,LRFLD,0),NEW=$P(^TMP(LR,$J,"S3",LRFLD),"|",2)
.S ^DD(63.3,LRFLD,0)=$P(DATA,U,1,2)_U_NEW_U_$P(DATA,U,4,99)
.S ^DD(63.3,LRFLD,"DT")=DT
;
Q
;---------------------------------------------------------------
FIX2 ; If no ^LR data found kill any 2 & 3 positions from ^DD(63.3
; (2=interp & 3=screen) based on the ANALYZE sub findings.
;
; Input: ^TMP(LR,$J,"SORT"
;
;Output: None
;
;-----
I '$D(^TMP(LR,$J,"SORT")) Q
;
N CNT,LRFLD,D1,DA,DIK,LRNUM,LRNAME,LR6206
;
S (LRFLD,D1)=""
F S LRFLD=$O(^TMP(LR,$J,"SORT",LRFLD)) Q:LRFLD="" D
.S LRNUM=$G(^TMP(LR,$J,"SORT",LRFLD,1))
.S LRNAME=$P($G(^DD(63.3,+LRNUM,0)),U)
.I $D(^TMP(LR,$J,"SORT",LRFLD,1)),LRNAME'[" INTERP",LRNAME'[" SCREEN" Q
.S LR6206=$O(^LAB(62.06,"AD",LRFLD,""))
.I LR6206 Q
.I '$D(^TMP(LR,$J,"CNT",LRFLD)) D
..F CNT=1,2,3 I $D(^TMP(LR,$J,"SORT",LRFLD,CNT)) D
...S DA=^TMP(LR,$J,"SORT",LRFLD,CNT)
...S DA(1)=LRSUBFIL,DIK="^DD("_DA(1)_","
...I FIX D ^DIK
...K ^TMP(LR,$J,"SORT",LRFLD,CNT)
..F CNT=0:1 S D1=$O(^TMP(LR,$J,"SORT",LRFLD,D1)) Q:D1=""
..I 'CNT K ^TMP(LR,$J,"SORT",LRFLD)
..E S $P(^TMP(LR,$J,"SORT",LRFLD),U)=CNT
;
Q
;---------------------------------------------------------------
FIX3 ; Fix 1 and 1,2 and 1,3 DD entries, leaving 2 and 3 and 2,3
;
; Input: ^TMP(LR,$J,"SORT"
;
;Output: ^TMP(LR,$J,"S4",ien1) = ien2 ^ ien3
;
; [where: ien1 = ^DD(63.3,ien1 (for the sensitivity)
; ien2 = ^DD(63.3,ien2 (for the interp)
; ien3 = ^DD(63.3,ien3 (for the screen)]
;
; ^TMP(LR,$J,"S5",ien) = ien1 ^ ien2 ^ ien3 ^ cnt
;
; [where: ien = old ^DD(63.3,ien (for old sensitivity)
; ien1 = ^DD(63.3,ien1 (for the sensitivity)
; ien2 = ^DD(63.3,ien2 (for the interp)
; ien3 = ^DD(63.3,ien3 (for the screen)
; cnt = total # of ^LR's that has been updated]
;-----
I '$D(^TMP(LR,$J,"SORT")) Q
;
N CNT,DATA,LRFLD,DA,DIK,LR6206,LRFDA,LRNAME,LRNAME1,LRNAME2
N LRNUM,LRNUM1,LRNUM2
;
S LRFLD=""
F S LRFLD=$O(^TMP(LR,$J,"SORT",LRFLD)) Q:LRFLD="" D
.S LR6206=$O(^LAB(62.06,"AD",LRFLD,""))
.I $D(^TMP(LR,$J,"SORT",LRFLD,1)) D
..S LRNUM=^TMP(LR,$J,"SORT",LRFLD,1)
..;
..; index and field match & are correct format.
..;
..I LRFLD=LRNUM,$E(LRNUM,1,$L(NBR))=NBR D Q
...S LRNUM1=LRNUM+.000000001,LRNUM2=LRNUM+.000000002
...S LRNAME=$P(^DD(63.3,LRNUM,0),U)
...I LRNAME[" INTERP"!(LRNAME[" SCREEN") Q
...S LRNAME1=LRNAME_" INTERP",LRNAME2=LRNAME_" SCREEN"
...I FIX D
....S DA(1)=LRSUBFIL,DIK="^DD("_DA(1)_","
....F DA=LRNUM,LRNUM1,LRNUM2 D ^DIK
....D SETFLDS^LRWU7
...S ^TMP(LR,$J,"S4",LRNUM)=LRNUM1_U_LRNUM2
...K ^TMP(LR,$J,"SORT",LRFLD)
..;
..; index and field don't match & are incorrect format.
..;
..I $E(LRNUM,1,$L(NBR))'=NBR D Q
...S LRNAME=$P(^DD(63.3,LRNUM,0),U)
...I LRNAME[" INTERP"!(LRNAME[" SCREEN") Q
...S LRNAME1=LRNAME_" INTERP",LRNAME2=LRNAME_" SCREEN"
...D NUMBER^LRWU7
...S DA=^TMP(LR,$J,"SORT",LRFLD,1)
...S DA(1)=LRSUBFIL,DIK="^DD("_DA(1)_","
...I FIX D
....D SETFLDS^LRWU7
....I LR6206]"" D
.....S LRFDA(62.06,LR6206_",",5)=LRNUM
.....D FILE^DIE(,"LRFDA")
.....;
.....D UPD624(LR6206,LRNUM) ; Update Auto Instrument File with new Drug Node
....F CNT=3,2,1 I $D(^TMP(LR,$J,"SORT",LRFLD,CNT)) D
.....S DA=^TMP(LR,$J,"SORT",LRFLD,CNT) D ^DIK
...S CNT=+$G(^TMP(LR,$J,"CNT",LRFLD))
...K ^TMP(LR,$J,"CNT",LRFLD)
...S ^TMP(LR,$J,"S5",DA)=LRNUM_U_LRNUM1_U_LRNUM2_U_CNT
...K ^TMP(LR,$J,"SORT",LRFLD)
...S ^TMP(LR,$J,"SORT",LRFLD,"NEW")=LRNUM
;
Q
;---------------------------------------------------------------
FIX4 ; Cleanup the ^LR entries for single DD's.
;
; Input: ^TMP(LR,$J,"SORT"
;
;Output: ^TMP(LR,$J,"S6",ien) = "" [where: ien = ^DD(63.3,ien]
;-----
I '$D(^TMP(LR,$J,"SORT")) Q
;
N CNT,D2,LRFLD,DA,DIK,LRDFN,LRIDT,LRN,LRNUM
;
S (LRDFN,LRIDT,D2)=""
F S LRDFN=$O(^LR(LRDFN)) Q:LRDFN="" D
.I '$D(^LR(LRDFN,"MI")) Q
.F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT="" D
..S D2=""
..F S D2=$O(^LR(LRDFN,"MI",LRIDT,3,D2)) Q:D2=""!(D2'?.N) D
...S LRFLD=2
...F S LRFLD=$O(^LR(LRDFN,"MI",LRIDT,3,D2,LRFLD)) Q:LRFLD=""!(LRFLD>3) D
....I '$D(^TMP(LR,$J,"SORT",LRFLD,"NEW")) Q
....S LRN=^TMP(LR,$J,"SORT",LRFLD,"NEW")
....I FIX D
.....I 'INSTALL D
......D SAY^XGF(24,1,"Repairing LRDFN: "_LRDFN_" LRIDT: "_LRIDT)
.....M ^LR(LRDFN,"MI",LRIDT,3,D2,LRN)=^LR(LRDFN,"MI",LRIDT,3,D2,LRFLD)
.....K ^LR(LRDFN,"MI",LRIDT,3,D2,LRFLD)
.....D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) ;Update Clinical Reminders Index
;
; Move all non-programatically fixed data to Scenario 6 (S6).
;
S (D2,LRFLD)=""
F S D2=$O(^TMP(LR,$J,"SORT",D2)) Q:D2="" D
.F S LRFLD=$O(^TMP(LR,$J,"SORT",D2,LRFLD)) Q:LRFLD="" D
..I LRFLD="NEW" K ^TMP(LR,$J,"SORT",D2,LRFLD) Q
..S DA=^TMP(LR,$J,"SORT",D2,LRFLD)
..S ^TMP(LR,$J,"S6",DA)=""
.K ^TMP(LR,$J,"SORT",D2)
;
; Remove S1,S2 and/or S3 entries that do not have
; associated DD entries.
;
S LRFLD=""
F D2="S1","S2","S3" D:$D(^TMP(LR,$J,D2))
.F S LRFLD=$O(^TMP(LR,$J,D2,LRFLD)) Q:LRFLD="" D
..I '$D(^DD(63.3,LRFLD)) K ^TMP(LR,$J,D2,LRFLD)
;
Q
;---------------------------------------------------------------
FIX5 ; Ensure that the fix entry is an ANTIBIOTIC NAME instead of an
; INTERP or SCREEN.
;
; Input: ^TMP(LR,$J,"S1" <= input transforms
; ^TMP(LR,$J,"S2" <= help text
; ^TMP(LR,$J,"S3" <= input keys
;
;Output: None
;-----
N TYPE,LRFLD,DATA,DA,DIK
;
F TYPE="S1","S2","S3" D
.S LRFLD=""
.F S LRFLD=$O(^TMP(LR,$J,TYPE,LRFLD)) Q:LRFLD="" D
..S DATA=$G(^DD(63.3,LRFLD,0))
..I $P($P(DATA,U,4),";",2)=1 D
...I $P(DATA,U)[" INTERP"!($P(DATA,U)[" SCREEN") K ^TMP(LR,$J,TYPE,LRFLD)
..I $P($P(DATA,U,4),";",2)=2 D
...I $P(DATA,U)'[" INTERP" K ^TMP(LR,$J,TYPE,LRFLD)
..I $P($P(DATA,U,4),";",2)=3 D
...I $P(DATA,U)'[" SCREEN" K ^TMP(LR,$J,TYPE,LRFLD)
Q
;
;---------------------------------------------------------------
;
UPD624(LR6206,LRNDRGND) ; Update Drug Node in Auto Instrument File
;
; Input:
; LR6206 - IEN in Antimicrobial Susceptibility File (#62.06)
; LRNDRGND - The new Drug Node
;
; Output: None
;
N LR624,LR6243,LR6246,LRDRUG
;
S LR624=0 F S LR624=$O(^LAB(62.4,LR624)) Q:'LR624 D
. ;
. S LR6243=0 F S LR6243=$O(^LAB(62.4,LR624,7,LR6243)) Q:'LR6243 D
. . ;
. . S LR6246=0 F S LR6246=$O(^LAB(62.4,LR624,7,LR6243,2,LR6246)) Q:'LR6246 D
. . . ;
. . . S LRDRUG=$P($G(^LAB(62.4,LR624,7,LR6243,2,LR6246,0)),U,1)
. . . ;
. . . I LRDRUG'=LR6206 Q
. . . ;
. . . N LRFDA,LRIENS
. . . S LRIENS=LR6246_","_LR6243_","_LR624_","
. . . S LRFDA(62.46,LRIENS,1)=LRNDRGND
. . . D FILE^DIE("","LRFDA")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRWU8 14499 printed Dec 13, 2024@02:23:22 Page 2
LRWU8 ;DALOI/WPW - TOOL TO FIX ORGANISM SUBFILE AND DATA ;06/06/12 16:06
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 ;Reference to ^DD supported by ICR# 29 and 999
+4 ;---------------------------------------------------------------
+5 ;
+6 ;Output:
+7 ;-------
+8 ; ^TMP("LR",$J,scenario [for email/report]
+9 ;
+10 ; scenario Description
+11 ; -------- -----------------------------------------------------
+12 ; S1........Bad Input Transform found.
+13 ; S2........Bad Help Text found.
+14 ; S3........Bad Key found.
+15 ; S4........Field number is good (ien) so build sensitivity,
+16 ; interp & screen definition based on good field
+17 ; number, no result data needs updating.
+18 ; S5........Field number is bad (ien) so delete bad definitions,
+19 ; build new sensitivity, interp & screen definitions
+20 ; and update results data as needed.
+21 ; S6........Everything left over that could not be
+22 ; programmatically corrected.
+23 ;
+24 ;---------------------------------------------------------------
EN ; Interactive entry point.
+1 ;
+2 NEW FIX,INSTALL,LR,LRSITE,LRSUBFIL,LRTYPE,NBR,TSTR,XMDUZ,XMY
+3 ;
+4 IF '$DATA(^XUSEC("LRLIASON",DUZ))
Begin DoDot:1
+5 WRITE !,"You do not have the LRLIASON key which is required to"
+6 WRITE " run this tool.",*7
End DoDot:1
QUIT
+7 ;
+8 SET FIX=$$ASK^LRWU8A()
SET INSTALL=0
+9 ;
+10 IF 'FIX
QUIT
+11 ;
+12 ;FIX=0: Analyze, FIX=1: Analyze and Fix.
SET FIX=FIX-1
+13 ;
+14 SET XMDUZ=DUZ
SET XMY(DUZ)=""
+15 ; call to get the email recipients list.
DO DES^XMA21
+16 ;
+17 ; setup screen
DO PREP^XGF
+18 ;
+19 DO INIT
DO SORT
DO DISCARD
DO ANALYZE
DO FIX0
DO FIX5
DO FIX1
DO FIX2
DO FIX3
DO FIX4
+20 ; send email/report
DO SEND^LRWU8A
+21 ; reset screen
DO CLEAN^XGF
+22 ;
+23 KILL ^TMP(LR,$JOB)
+24 ;
+25 QUIT
+26 ;---------------------------------------------------------------
KIDS ; Entry point for post install run.
+1 ;
+2 NEW FIX,INSTALL,LR,LRSITE,LRSUBFIL,LRTYPE,NBR,XMY
+3 ;
+4 IF $$PROD^XUPROD()
IF $GET(^XMB("NETNAME"))["DOMAIN.EXT"
SET XMY("G.LAB DEV IRMFO@DOMAIN.EXT")=""
SET XMY("G.CSCLIN4@DOMAIN.EXT")=""
+5 ;[ccr-8167]
SET XMY(DUZ)=""
SET XMY("G.LMI")=""
SET FIX=0
SET INSTALL=1
+6 ;
+7 DO INIT
DO SORT
DO DISCARD
DO ANALYZE
DO FIX0
DO FIX5
DO FIX1
DO FIX2
DO FIX3
DO FIX4
+8 ; send email/report
DO SEND^LRWU8A
+9 ;
+10 KILL ^TMP(LR,$JOB)
+11 ;
+12 QUIT
+13 ;---------------------------------------------------------------
LRNIGHT ; Entry point for ^LRNIGHT run.
+1 ;
+2 NEW FIX,INSTALL,LR,LRSITE,LRSUBFIL,LRTYPE,NBR,XMY
+3 ;
+4 IF $$PROD^XUPROD()
IF $GET(^XMB("NETNAME"))["DOMAIN.EXT"
SET XMY("G.LAB DEV IRMFO@DOMAIN.EXT")=""
SET XMY("G.CSCLIN4@DOMAIN.EXT")=""
+5 SET (XMY(DUZ),XMY("G.LMI"))=""
SET FIX=0
SET INSTALL=1
+6 ;
+7 DO INIT
DO SORT
DO DISCARD
DO ANALYZE
DO FIX0
DO FIX5
DO FIX1
DO FIX2
DO FIX3
DO FIX4
+8 ; send email/report
IF $DATA(^TMP(LR,$JOB))
DO SEND^LRWU8A
+9 ;
+10 KILL ^TMP(LR,$JOB)
+11 ;
+12 QUIT
+13 ;---------------------------------------------------------------
INIT ; Initialize variables and such...
+1 ;
+2 ; load fileman variables.
DO DT^DICRW
+3 ;
+4 SET LRTYPE=1
SET LR="LR"
SET LRSITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))
+5 SET NBR="2.00"_LRSITE
SET LRSUBFIL=63.3
SET DT=$$DT^XLFDT
+6 ;
+7 ; Ignore fields inadvertently distributed by a previous Lab patch from
+8 ; a development account to some VA sites during patch testing.
+9 ; These fields were name spaced under site number 170 and 600.
+10 SET TSTR=""
+11 IF $EXTRACT(LRSITE,1,3)'=170
SET TSTR=TSTR_"|2.00170001|2.00170002|2.00170003|2.00170004|2.00170005"
+12 IF $EXTRACT(LRSITE,1,3)'=600
SET TSTR=TSTR_"|2.00600001|2.00600002|2.00600003|2.00600004|2.00600005|2.00600006|2.00600007"
+13 SET TSTR=TSTR_"|"
+14 ;
+15 KILL ^TMP(LR,$JOB)
+16 ;
+17 QUIT
+18 ;---------------------------------------------------------------
SORT ; Sort Antibiotics fields: 1-Sensitivity, 2-Interp & 3-Screen.
+1 ;
+2 ; Input: None.
+3 ;
+4 ;Output: ^TMP(LR,$j,"SORT", = field number sort + 1, 2 and/or 3
+5 ; ^TMP(LR,$j,"S1",ien) = bad input transform
+6 ; ^TMP(LR,$j,"S2",ien) = bad help text
+7 ; ^TMP(LR,$j,"S3",ien) = bad key
+8 ;-----
+9 NEW D0,DATA,HELP,IT,KEY,NKEY
+10 ;
+11 SET NKEY="A:ALWAYS DISPLAY;N:NEVER DISPLAY;R:RESTRICT DISPLAY;"
+12 ;
+13 SET D0=""
+14 FOR
SET D0=$ORDER(^DD(63.3,D0))
if D0=""
QUIT
if $DATA(^DD(63.3,D0,0))
Begin DoDot:1
+15 SET DATA=$GET(^DD(63.3,D0,0))
if DATA=""
QUIT
+16 IF +$PIECE(DATA,U,4)<2
QUIT
+17 IF +$PIECE(DATA,U,4)>2.99999999
QUIT
+18 SET IT=$PIECE(DATA,U,5,99)
SET HELP=$GET(^DD(63.3,D0,4))
SET KEY=$PIECE(DATA,U,3)
+19 IF $PIECE($PIECE(DATA,U,4),";",2)=1
Begin DoDot:2
+20 IF IT'="D ^LRMISR"
Begin DoDot:3
+21 SET ^TMP(LR,$JOB,"S1",D0)=IT_"|D ^LRMISR"
End DoDot:3
+22 IF HELP'="D EN^LRMISR"
Begin DoDot:3
+23 SET ^TMP(LR,$JOB,"S2",D0)=HELP_"|D EN^LRMISR"
End DoDot:3
End DoDot:2
+24 IF $PIECE($PIECE(DATA,U,4),";",2)=2
Begin DoDot:2
+25 IF IT'="D INT^LRMISR"
Begin DoDot:3
+26 SET ^TMP(LR,$JOB,"S1",D0)=IT_"|D INT^LRMISR"
End DoDot:3
+27 IF HELP'="D HINT^LRMISR"
Begin DoDot:3
+28 SET ^TMP(LR,$JOB,"S2",D0)=HELP_"|D HINT^LRMISR"
End DoDot:3
End DoDot:2
+29 IF $PIECE($PIECE(DATA,U,4),";",2)=3
Begin DoDot:2
+30 IF IT'="Q"
Begin DoDot:3
+31 SET ^TMP(LR,$JOB,"S1",D0)=IT_"|Q"
End DoDot:3
+32 IF KEY'=NKEY
Begin DoDot:3
+33 SET ^TMP(LR,$JOB,"S3",D0)=KEY_"|"_NKEY
End DoDot:3
End DoDot:2
+34 SET ^TMP(LR,$JOB,"SORT",+$PIECE(DATA,U,4),$PIECE($PIECE(DATA,U,4),";",2))=D0
End DoDot:1
+35 ;
+36 QUIT
+37 ;---------------------------------------------------------------
DISCARD ; Discard Antibiotic if all 3 tests are defined.
+1 ;
+2 ; Input: ^TMP(LR,$J,"SORT"
+3 ;
+4 ;Output: ^TMP(LR,$J,"SORT"
+5 ;-----
+6 NEW CNT,DATA,LRX,LRFLD
+7 ;
+8 SET (LRX,LRFLD)=""
+9 FOR
SET LRFLD=$ORDER(^TMP(LR,$JOB,"SORT",LRFLD))
if LRFLD=""
QUIT
Begin DoDot:1
+10 FOR CNT=0:1
SET LRX=$ORDER(^TMP(LR,$JOB,"SORT",LRFLD,LRX))
if LRX=""
QUIT
Begin DoDot:2
+11 SET DATA=^TMP(LR,$JOB,"SORT",LRFLD,LRX)
End DoDot:2
+12 ;
+13 ; Ignore fields inadvertently distributed by a previous Lab patch from
+14 ; a development account to some VA sites during patch testing.
+15 ; These fields were name spaced under site number 170 and 600.
+16 IF CNT=3
IF TSTR'[("|"_LRFLD_"|")
KILL ^TMP(LR,$JOB,"SORT",LRFLD)
QUIT
+17 SET ^TMP(LR,$JOB,"SORT",LRFLD)=CNT_U_DATA
End DoDot:1
+18 ;
+19 QUIT
+20 ;---------------------------------------------------------------
ANALYZE ; Check ^LR for entries after discard.
+1 ;
+2 ; Input: ^TMP(LR,$J,"SORT"
+3 ;
+4 ;Output: ^TMP(LR,$J,"CNT",LRFLD = total result entries for ien
+5 ;-----
+6 IF '$DATA(^TMP(LR,$JOB,"SORT"))
QUIT
+7 ;
+8 NEW CNT,D2,LRFLD,LRDFN,LRIDT
+9 ;
+10 SET (LRDFN,LRIDT,D2,LRFLD)=""
+11 FOR CNT=1:1
SET LRDFN=$ORDER(^LR(LRDFN))
if LRDFN=""
QUIT
Begin DoDot:1
+12 IF 'INSTALL
Begin DoDot:2
+13 IF (CNT#1000)=1
DO SAY^XGF(24,1,"Analyzing LRDFN: "_LRDFN)
End DoDot:2
+14 IF '$DATA(^LR(LRDFN,"MI"))
QUIT
+15 FOR
SET LRIDT=$ORDER(^LR(LRDFN,"MI",LRIDT))
if LRIDT=""
QUIT
Begin DoDot:2
+16 IF '$DATA(^LR(LRDFN,"MI",LRIDT,3))
QUIT
+17 FOR
SET D2=$ORDER(^LR(LRDFN,"MI",LRIDT,3,D2))
if D2=""
QUIT
Begin DoDot:3
+18 FOR
SET LRFLD=$ORDER(^TMP(LR,$JOB,"SORT",LRFLD))
if LRFLD=""
QUIT
Begin DoDot:4
+19 IF '$DATA(^LR(LRDFN,"MI",LRIDT,3,D2,LRFLD))
QUIT
+20 SET ^TMP(LR,$JOB,"CNT",LRFLD)=$GET(^TMP(LR,$JOB,"CNT",LRFLD))+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 QUIT
+23 ;---------------------------------------------------------------
FIX0 ; Cleanup non data leftover fields from previous patches.
+1 ;
+2 ; Input: ^TMP(LR,$J,"SORT"
+3 ;
+4 ;Output: None
+5 ;-----
+6 IF '$DATA(^TMP(LR,$JOB,"SORT"))
QUIT
+7 ;
+8 NEW CNT,DA,DIK,LRFLD,LRTNODE,PCE
+9 ;
+10 FOR PCE=2:1
SET LRFLD=$PIECE(TSTR,"|",PCE)
if LRFLD=""
QUIT
Begin DoDot:1
+11 IF +$GET(^TMP(LR,$JOB,"CNT",LRFLD))
Begin DoDot:2
+12 IF +$GET(^TMP(LR,$JOB,"SORT",LRFLD))=3
Begin DoDot:3
+13 KILL ^TMP(LR,$JOB,"SORT",LRFLD),^TMP(LR,$JOB,"CNT",LRFLD)
End DoDot:3
End DoDot:2
QUIT
+14 ;
+15 FOR CNT=1:1:3
IF $DATA(^TMP(LR,$JOB,"SORT",LRFLD,CNT))
Begin DoDot:2
+16 SET DA=^TMP(LR,$JOB,"SORT",LRFLD,CNT)
+17 SET DA(1)=LRSUBFIL
SET DIK="^DD("_DA(1)_","
+18 IF FIX
DO ^DIK
+19 FOR LRTNODE="S1","S2","S3"
KILL ^TMP(LR,$JOB,LRTNODE,DA)
End DoDot:2
+20 ;
+21 KILL ^TMP(LR,$JOB,"SORT",LRFLD)
End DoDot:1
+22 ;
+23 QUIT
+24 ;---------------------------------------------------------------
FIX1 ; Cleanup the bad Input Transforms, Help Text and Input Keys.
+1 ;
+2 ; Input: ^TMP(LR,$J,"S1" <= input transforms
+3 ; ^TMP(LR,$J,"S2" <= help text
+4 ; ^TMP(LR,$J,"S3" <= input keys
+5 ;
+6 ;Output: None
+7 ;-----
+8 IF 'FIX
QUIT
+9 IF '$DATA(^TMP(LR,$JOB,"S1"))
IF '$DATA(^TMP(LR,$JOB,"S2"))
IF '$DATA(^TMP(LR,$JOB,"S3"))
QUIT
+10 ;
+11 NEW DATA,LRFLD,NEW
+12 ;
+13 SET LRFLD=""
+14 FOR
SET LRFLD=$ORDER(^TMP(LR,$JOB,"S1",LRFLD))
if LRFLD=""
QUIT
Begin DoDot:1
+15 SET DATA=^DD(63.3,LRFLD,0)
SET NEW=$PIECE(^TMP(LR,$JOB,"S1",LRFLD),"|",2)
+16 SET ^DD(63.3,LRFLD,0)=$PIECE(DATA,U,1,4)_U_NEW
+17 SET ^DD(63.3,LRFLD,"DT")=DT
End DoDot:1
+18 ;
+19 FOR
SET LRFLD=$ORDER(^TMP(LR,$JOB,"S2",LRFLD))
if LRFLD=""
QUIT
Begin DoDot:1
+20 SET ^DD(63.3,LRFLD,4)=$PIECE(^TMP(LR,$JOB,"S2",LRFLD),"|",2)
+21 SET ^DD(63.3,LRFLD,"DT")=DT
End DoDot:1
+22 ;
+23 FOR
SET LRFLD=$ORDER(^TMP(LR,$JOB,"S3",LRFLD))
if LRFLD=""
QUIT
Begin DoDot:1
+24 SET DATA=^DD(63.3,LRFLD,0)
SET NEW=$PIECE(^TMP(LR,$JOB,"S3",LRFLD),"|",2)
+25 SET ^DD(63.3,LRFLD,0)=$PIECE(DATA,U,1,2)_U_NEW_U_$PIECE(DATA,U,4,99)
+26 SET ^DD(63.3,LRFLD,"DT")=DT
End DoDot:1
+27 ;
+28 QUIT
+29 ;---------------------------------------------------------------
FIX2 ; If no ^LR data found kill any 2 & 3 positions from ^DD(63.3
+1 ; (2=interp & 3=screen) based on the ANALYZE sub findings.
+2 ;
+3 ; Input: ^TMP(LR,$J,"SORT"
+4 ;
+5 ;Output: None
+6 ;
+7 ;-----
+8 IF '$DATA(^TMP(LR,$JOB,"SORT"))
QUIT
+9 ;
+10 NEW CNT,LRFLD,D1,DA,DIK,LRNUM,LRNAME,LR6206
+11 ;
+12 SET (LRFLD,D1)=""
+13 FOR
SET LRFLD=$ORDER(^TMP(LR,$JOB,"SORT",LRFLD))
if LRFLD=""
QUIT
Begin DoDot:1
+14 SET LRNUM=$GET(^TMP(LR,$JOB,"SORT",LRFLD,1))
+15 SET LRNAME=$PIECE($GET(^DD(63.3,+LRNUM,0)),U)
+16 IF $DATA(^TMP(LR,$JOB,"SORT",LRFLD,1))
IF LRNAME'[" INTERP"
IF LRNAME'[" SCREEN"
QUIT
+17 SET LR6206=$ORDER(^LAB(62.06,"AD",LRFLD,""))
+18 IF LR6206
QUIT
+19 IF '$DATA(^TMP(LR,$JOB,"CNT",LRFLD))
Begin DoDot:2
+20 FOR CNT=1,2,3
IF $DATA(^TMP(LR,$JOB,"SORT",LRFLD,CNT))
Begin DoDot:3
+21 SET DA=^TMP(LR,$JOB,"SORT",LRFLD,CNT)
+22 SET DA(1)=LRSUBFIL
SET DIK="^DD("_DA(1)_","
+23 IF FIX
DO ^DIK
+24 KILL ^TMP(LR,$JOB,"SORT",LRFLD,CNT)
End DoDot:3
+25 FOR CNT=0:1
SET D1=$ORDER(^TMP(LR,$JOB,"SORT",LRFLD,D1))
if D1=""
QUIT
+26 IF 'CNT
KILL ^TMP(LR,$JOB,"SORT",LRFLD)
+27 IF '$TEST
SET $PIECE(^TMP(LR,$JOB,"SORT",LRFLD),U)=CNT
End DoDot:2
End DoDot:1
+28 ;
+29 QUIT
+30 ;---------------------------------------------------------------
FIX3 ; Fix 1 and 1,2 and 1,3 DD entries, leaving 2 and 3 and 2,3
+1 ;
+2 ; Input: ^TMP(LR,$J,"SORT"
+3 ;
+4 ;Output: ^TMP(LR,$J,"S4",ien1) = ien2 ^ ien3
+5 ;
+6 ; [where: ien1 = ^DD(63.3,ien1 (for the sensitivity)
+7 ; ien2 = ^DD(63.3,ien2 (for the interp)
+8 ; ien3 = ^DD(63.3,ien3 (for the screen)]
+9 ;
+10 ; ^TMP(LR,$J,"S5",ien) = ien1 ^ ien2 ^ ien3 ^ cnt
+11 ;
+12 ; [where: ien = old ^DD(63.3,ien (for old sensitivity)
+13 ; ien1 = ^DD(63.3,ien1 (for the sensitivity)
+14 ; ien2 = ^DD(63.3,ien2 (for the interp)
+15 ; ien3 = ^DD(63.3,ien3 (for the screen)
+16 ; cnt = total # of ^LR's that has been updated]
+17 ;-----
+18 IF '$DATA(^TMP(LR,$JOB,"SORT"))
QUIT
+19 ;
+20 NEW CNT,DATA,LRFLD,DA,DIK,LR6206,LRFDA,LRNAME,LRNAME1,LRNAME2
+21 NEW LRNUM,LRNUM1,LRNUM2
+22 ;
+23 SET LRFLD=""
+24 FOR
SET LRFLD=$ORDER(^TMP(LR,$JOB,"SORT",LRFLD))
if LRFLD=""
QUIT
Begin DoDot:1
+25 SET LR6206=$ORDER(^LAB(62.06,"AD",LRFLD,""))
+26 IF $DATA(^TMP(LR,$JOB,"SORT",LRFLD,1))
Begin DoDot:2
+27 SET LRNUM=^TMP(LR,$JOB,"SORT",LRFLD,1)
+28 ;
+29 ; index and field match & are correct format.
+30 ;
+31 IF LRFLD=LRNUM
IF $EXTRACT(LRNUM,1,$LENGTH(NBR))=NBR
Begin DoDot:3
+32 SET LRNUM1=LRNUM+.000000001
SET LRNUM2=LRNUM+.000000002
+33 SET LRNAME=$PIECE(^DD(63.3,LRNUM,0),U)
+34 IF LRNAME[" INTERP"!(LRNAME[" SCREEN")
QUIT
+35 SET LRNAME1=LRNAME_" INTERP"
SET LRNAME2=LRNAME_" SCREEN"
+36 IF FIX
Begin DoDot:4
+37 SET DA(1)=LRSUBFIL
SET DIK="^DD("_DA(1)_","
+38 FOR DA=LRNUM,LRNUM1,LRNUM2
DO ^DIK
+39 DO SETFLDS^LRWU7
End DoDot:4
+40 SET ^TMP(LR,$JOB,"S4",LRNUM)=LRNUM1_U_LRNUM2
+41 KILL ^TMP(LR,$JOB,"SORT",LRFLD)
End DoDot:3
QUIT
+42 ;
+43 ; index and field don't match & are incorrect format.
+44 ;
+45 IF $EXTRACT(LRNUM,1,$LENGTH(NBR))'=NBR
Begin DoDot:3
+46 SET LRNAME=$PIECE(^DD(63.3,LRNUM,0),U)
+47 IF LRNAME[" INTERP"!(LRNAME[" SCREEN")
QUIT
+48 SET LRNAME1=LRNAME_" INTERP"
SET LRNAME2=LRNAME_" SCREEN"
+49 DO NUMBER^LRWU7
+50 SET DA=^TMP(LR,$JOB,"SORT",LRFLD,1)
+51 SET DA(1)=LRSUBFIL
SET DIK="^DD("_DA(1)_","
+52 IF FIX
Begin DoDot:4
+53 DO SETFLDS^LRWU7
+54 IF LR6206]""
Begin DoDot:5
+55 SET LRFDA(62.06,LR6206_",",5)=LRNUM
+56 DO FILE^DIE(,"LRFDA")
+57 ;
+58 ; Update Auto Instrument File with new Drug Node
DO UPD624(LR6206,LRNUM)
End DoDot:5
+59 FOR CNT=3,2,1
IF $DATA(^TMP(LR,$JOB,"SORT",LRFLD,CNT))
Begin DoDot:5
+60 SET DA=^TMP(LR,$JOB,"SORT",LRFLD,CNT)
DO ^DIK
End DoDot:5
End DoDot:4
+61 SET CNT=+$GET(^TMP(LR,$JOB,"CNT",LRFLD))
+62 KILL ^TMP(LR,$JOB,"CNT",LRFLD)
+63 SET ^TMP(LR,$JOB,"S5",DA)=LRNUM_U_LRNUM1_U_LRNUM2_U_CNT
+64 KILL ^TMP(LR,$JOB,"SORT",LRFLD)
+65 SET ^TMP(LR,$JOB,"SORT",LRFLD,"NEW")=LRNUM
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+66 ;
+67 QUIT
+68 ;---------------------------------------------------------------
FIX4 ; Cleanup the ^LR entries for single DD's.
+1 ;
+2 ; Input: ^TMP(LR,$J,"SORT"
+3 ;
+4 ;Output: ^TMP(LR,$J,"S6",ien) = "" [where: ien = ^DD(63.3,ien]
+5 ;-----
+6 IF '$DATA(^TMP(LR,$JOB,"SORT"))
QUIT
+7 ;
+8 NEW CNT,D2,LRFLD,DA,DIK,LRDFN,LRIDT,LRN,LRNUM
+9 ;
+10 SET (LRDFN,LRIDT,D2)=""
+11 FOR
SET LRDFN=$ORDER(^LR(LRDFN))
if LRDFN=""
QUIT
Begin DoDot:1
+12 IF '$DATA(^LR(LRDFN,"MI"))
QUIT
+13 FOR
SET LRIDT=$ORDER(^LR(LRDFN,"MI",LRIDT))
if LRIDT=""
QUIT
Begin DoDot:2
+14 SET D2=""
+15 FOR
SET D2=$ORDER(^LR(LRDFN,"MI",LRIDT,3,D2))
if D2=""!(D2'?.N)
QUIT
Begin DoDot:3
+16 SET LRFLD=2
+17 FOR
SET LRFLD=$ORDER(^LR(LRDFN,"MI",LRIDT,3,D2,LRFLD))
if LRFLD=""!(LRFLD>3)
QUIT
Begin DoDot:4
+18 IF '$DATA(^TMP(LR,$JOB,"SORT",LRFLD,"NEW"))
QUIT
+19 SET LRN=^TMP(LR,$JOB,"SORT",LRFLD,"NEW")
+20 IF FIX
Begin DoDot:5
+21 IF 'INSTALL
Begin DoDot:6
+22 DO SAY^XGF(24,1,"Repairing LRDFN: "_LRDFN_" LRIDT: "_LRIDT)
End DoDot:6
+23 MERGE ^LR(LRDFN,"MI",LRIDT,3,D2,LRN)=^LR(LRDFN,"MI",LRIDT,3,D2,LRFLD)
+24 KILL ^LR(LRDFN,"MI",LRIDT,3,D2,LRFLD)
+25 ;Update Clinical Reminders Index
DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;
+27 ; Move all non-programatically fixed data to Scenario 6 (S6).
+28 ;
+29 SET (D2,LRFLD)=""
+30 FOR
SET D2=$ORDER(^TMP(LR,$JOB,"SORT",D2))
if D2=""
QUIT
Begin DoDot:1
+31 FOR
SET LRFLD=$ORDER(^TMP(LR,$JOB,"SORT",D2,LRFLD))
if LRFLD=""
QUIT
Begin DoDot:2
+32 IF LRFLD="NEW"
KILL ^TMP(LR,$JOB,"SORT",D2,LRFLD)
QUIT
+33 SET DA=^TMP(LR,$JOB,"SORT",D2,LRFLD)
+34 SET ^TMP(LR,$JOB,"S6",DA)=""
End DoDot:2
+35 KILL ^TMP(LR,$JOB,"SORT",D2)
End DoDot:1
+36 ;
+37 ; Remove S1,S2 and/or S3 entries that do not have
+38 ; associated DD entries.
+39 ;
+40 SET LRFLD=""
+41 FOR D2="S1","S2","S3"
if $DATA(^TMP(LR,$JOB,D2))
Begin DoDot:1
+42 FOR
SET LRFLD=$ORDER(^TMP(LR,$JOB,D2,LRFLD))
if LRFLD=""
QUIT
Begin DoDot:2
+43 IF '$DATA(^DD(63.3,LRFLD))
KILL ^TMP(LR,$JOB,D2,LRFLD)
End DoDot:2
End DoDot:1
+44 ;
+45 QUIT
+46 ;---------------------------------------------------------------
FIX5 ; Ensure that the fix entry is an ANTIBIOTIC NAME instead of an
+1 ; INTERP or SCREEN.
+2 ;
+3 ; Input: ^TMP(LR,$J,"S1" <= input transforms
+4 ; ^TMP(LR,$J,"S2" <= help text
+5 ; ^TMP(LR,$J,"S3" <= input keys
+6 ;
+7 ;Output: None
+8 ;-----
+9 NEW TYPE,LRFLD,DATA,DA,DIK
+10 ;
+11 FOR TYPE="S1","S2","S3"
Begin DoDot:1
+12 SET LRFLD=""
+13 FOR
SET LRFLD=$ORDER(^TMP(LR,$JOB,TYPE,LRFLD))
if LRFLD=""
QUIT
Begin DoDot:2
+14 SET DATA=$GET(^DD(63.3,LRFLD,0))
+15 IF $PIECE($PIECE(DATA,U,4),";",2)=1
Begin DoDot:3
+16 IF $PIECE(DATA,U)[" INTERP"!($PIECE(DATA,U)[" SCREEN")
KILL ^TMP(LR,$JOB,TYPE,LRFLD)
End DoDot:3
+17 IF $PIECE($PIECE(DATA,U,4),";",2)=2
Begin DoDot:3
+18 IF $PIECE(DATA,U)'[" INTERP"
KILL ^TMP(LR,$JOB,TYPE,LRFLD)
End DoDot:3
+19 IF $PIECE($PIECE(DATA,U,4),";",2)=3
Begin DoDot:3
+20 IF $PIECE(DATA,U)'[" SCREEN"
KILL ^TMP(LR,$JOB,TYPE,LRFLD)
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
+23 ;---------------------------------------------------------------
+24 ;
UPD624(LR6206,LRNDRGND) ; Update Drug Node in Auto Instrument File
+1 ;
+2 ; Input:
+3 ; LR6206 - IEN in Antimicrobial Susceptibility File (#62.06)
+4 ; LRNDRGND - The new Drug Node
+5 ;
+6 ; Output: None
+7 ;
+8 NEW LR624,LR6243,LR6246,LRDRUG
+9 ;
+10 SET LR624=0
FOR
SET LR624=$ORDER(^LAB(62.4,LR624))
if 'LR624
QUIT
Begin DoDot:1
+11 ;
+12 SET LR6243=0
FOR
SET LR6243=$ORDER(^LAB(62.4,LR624,7,LR6243))
if 'LR6243
QUIT
Begin DoDot:2
+13 ;
+14 SET LR6246=0
FOR
SET LR6246=$ORDER(^LAB(62.4,LR624,7,LR6243,2,LR6246))
if 'LR6246
QUIT
Begin DoDot:3
+15 ;
+16 SET LRDRUG=$PIECE($GET(^LAB(62.4,LR624,7,LR6243,2,LR6246,0)),U,1)
+17 ;
+18 IF LRDRUG'=LR6206
QUIT
+19 ;
+20 NEW LRFDA,LRIENS
+21 SET LRIENS=LR6246_","_LR6243_","_LR624_","
+22 SET LRFDA(62.46,LRIENS,1)=LRNDRGND
+23 DO FILE^DIE("","LRFDA")
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
+25 QUIT
