LR7OV0 ;DALOI/STAFF - Update orderable items ;Mar 16, 2021@16:42
;;5.2;LAB SERVICE;**121,187,357,361,350,434,543**;Sep 27, 1994;Build 7
;
;Reference to ^ORD(101.43 supported by DBIA #2843
;
TEST(TEST,ICNT) ;Process single test
;TEST=test ptr to file 60
;ICNT=Current counter in ORUPDMSG(ICNT)
N TYPE,TESTID,IFN,IFN1,CTR,CTR1,GENW,X0,S0,SAMP,MAX,DMAX,COLLECT,SAMPLE,SPEC,SUBID,SYN,COST,WCOM,Y9,Y10,Y11
Q:'$D(^LAB(60,TEST,0)) S X0=^(0),COST=$P(X0,"^",11),SUB=$P(X0,"^",4),TYPE=$P(X0,"^",3),CTR1=0
I $D(^LAB(60,TEST,6)) S (CTR,IFN)=0 F S IFN=$O(^LAB(60,TEST,6,IFN)) Q:IFN<1 S CTR=CTR+1,GENW(CTR)=^(IFN,0)
S (CTR,IFN)=0 F S IFN=$O(^LAB(60,TEST,5,IFN)) Q:IFN<1 S CTR=CTR+1,SYN(CTR)=^(IFN,0)
S (Y9,Y10,Y11)="" I $P($G(^LAB(60,TEST,64)),"^") S Y9=$P(^(64),"^"),Y10=$P(^LAM(Y9,0),"^"),Y9=$P(^(0),"^",2),Y11="99NLT"
D
. S (COLLECT,SAMP,SPEC)=0,TESTID=$$UVID^LR7OU0(TEST,+SPEC,Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)=$$MFE(MFECODE,TESTID)
. S ICNT=ICNT+1,ORUPDMSG(ICNT)=$$ZLR("","",CTR1,SUB,"","",COST,TYPE)
. S IFN1=0 F S IFN1=$O(^LAB(60,TEST,2,IFN1)) Q:IFN1<1 S X=^(IFN1,0) I $D(^LAB(60,+X,0)) D
.. N Y9,Y10,Y11 S (Y9,Y10,Y11)="" I $P($G(^LAB(60,+X,64)),"^") S Y9=$P(^(64),"^"),Y10=$P(^LAM(Y9,0),"^"),Y9=$P(^(0),"^",2),Y11="99NLT"
.. S SUBID=$$UVID^LR7OU0($P(X,"^"),"",Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)="ZLC||||"_SUBID
. D ZSY(.SYN),NTE(.GENW,.WCOM)
Q
;
MFE(EVENT,KEY) ;MFE component
;EVENT=MAD-Add Record, MDL-Delete Record, MUP-Update Record
; MDC-Deactivate, MAC-Reactivate
N MFE
S MFE="MFE|"_EVENT_"|||"_KEY
Q MFE
;
ZLR(SPEC,COLLECT,SEQ,SUB,MAXORD,DMAXORD,COST,TYPE) ;ZLR component
N ZLR
S ZLR="ZLR|"_SPEC_"|"_COLLECT_"|"_SEQ_"|"_SUB_"|"_MAXORD_"|"_DMAXORD_"|"_COST_"|"_TYPE
Q ZLR
;
ZSY(SYN) ;ZSY component
N IFN
S IFN=0 F S IFN=$O(SYN(IFN)) Q:IFN<1 S ICNT=ICNT+1,ORUPDMSG(ICNT)="ZSY|"_IFN_"|"_SYN(IFN)
Q
;
NTE(GEN,COM) ;NTE component
N IFN,CTR S CTR=0
S ICNT=ICNT+1 D NTE^LR7OU01(CTR,"P","GEN(",ICNT)
S ICNT=ICNT+1 D NTE^LR7OU01(CTR,"P","COM(",ICNT)
Q
;
MFI(EVENT) ;MFI component
;EVENT=REP for initial population of orderables
; =UPD for subsequent updates
N MFI
S MFI="MFI|60^Lab Test^99DD||"_EVENT_"|||NE"
Q MFI
;
SINGLE(TEST,MFICODE,MFECODE) ;Message for a single test
;TEST= ptr to test in file 60
;MFICODE=File Level Event Code
;MFECODE=Record Level Event Code
;N X,ORUPDMSG,MSG
L +LR7OV0(TEST):9999
S MSG="ORUPDMSG",X=$$MSH^LR7OU0("MFN"),ORUPDMSG(1)=X
S X=$$MFI(MFICODE),ORUPDMSG(2)=X
D TEST(TEST,2)
;W !!,$P(^LAB(60,TEST,0),"^"),! I $D(ORUPDMSG(3)) ZW ORUPDMSG
;
; If test deleted then mark file 101.43 entry as "inactive"
I '$D(^LAB(60,TEST,0)) D
. N TESTID
. S MFECODE="MDC"
. S TESTID=$$UVID^LR7OU0(TEST,0,"","","","ORUPDMSG")
. S ORUPDMSG(3)=$$MFE(MFECODE,TESTID)
. ;LR*5.2*543: send mail message for manual correction
. D MAIL
I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message
L -LR7OV0(TEST)
Q
;
MAIL ;
;LR*5.2*543
N LR10143,LRNAME,LRMIN,LRMY,LRMSUB,LRMTEXT
S LR10143=$P(TESTID,"^",4)_";"_$P(TESTID,"^",6)
S LR10143=$O(^ORD(101.43,"ID",LR10143,0))
Q:LR10143']""
S LRNAME=$P($G(^ORD(101.43,LR10143,0)),"^")
;Do not send message if name begins with "ZZ".
;Transaction has been sent to CPRS to mark the OI inactive, but it
;might not have filed yet. So no need to check for the inactive field.
I $E(LRNAME,1,2)="ZZ" Q
S LRMIN("FROM")="ORDERABLE ITEMS UPDATE TASK"
S LRMY(DUZ)="",LRMY("G.LMI")="",LRMY("G.OR CACS")=""
S LRMSUB="ATTENTION: Lab Test Deleted"
S LRMTEXT(1)="Lab test IEN: "_TEST_" ("_LRNAME_") has been deleted, but an orderable item"
S LRMTEXT(2)="(IEN: "_LR10143_") exists in the ORDERABLE ITEMS (#101.43) file."
S LRMTEXT(3)=" "
S LRMTEXT(4)="The orderable item should be edited to prefix the name with ""ZZ"" and"
S LRMTEXT(5)="make sure there is a date in the INACTIVATED (#.1) field."
S LRMTEXT="LRMTEXT"
D SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
Q
;
ADD(TEST) ;Add single record to Master file
N MFICODE,MFECODE S MFECODE="MAD",MFICODE="REP" D SINGLE(TEST,MFICODE,MFECODE)
Q
;
DEL(TEST) ;Delete single record from Master file
N MFICODE,MFECODE S MFECODE="MDL",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
Q
;
UPD(TEST) ;Update record in Master file
;Modified for patch LR*5.2*361
N ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO
S ZTSAVE("TEST")=TEST
S ZTRTN="TUPD^LR7OV0"
S ZTDESC="LABORATORY TEST FILE HL7 update message"
S ZTDTH=$H
S ZTIO=""
D ^%ZTLOAD
Q
;
TUPD ;Tasked update of record in Master file
;Added for patch LR*5.2*361
N MFICODE,MFECODE S MFECODE="MUP",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
Q
;
DEACT(TEST) ;Deactivate record in Master file
N MFICODE,MFECODE S MFECODE="MDC",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
Q
;
REACT(TEST) ;Reactivate record in Master file
N MFICODE,MFECODE S MFECODE="MAC",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
Q
;
;Following code added to support LR*5.2*357
;Following code modified to support LR*5.2*361
;Designed to help update the ORDERABLE ITEMS FILE (file 101.43) after the deletion
;of a SYNONYM from the LABORATORY TEST file (file 60).
UPD2(TEST,KSYN) ;Update record in Master file - Modified for LR*5.2*361
;TEST = IEN of lab test in file 60
;KSYN = IEN of synonym to be deleted from lab test in file 60
;Modified for LR*5.2*361
N ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO
S ZTSAVE("TEST")=TEST
S ZTSAVE("KSYN")=KSYN
S ZTRTN="TUPD2^LR7OV0"
S ZTDESC="LABORATORY TEST FILE HL7 update message"
S ZTDTH=$H
S ZTIO=""
D ^%ZTLOAD
Q
;
TUPD2 ;Update record in Master file
;TEST = IEN of lab test in file 60
;KSYN = IEN of synonym to be deleted from lab test in file 60
N MFICODE,MFECODE S MFECODE="MUP",MFICODE="UPD" D SINGLE2(TEST,KSYN,MFICODE,MFECODE)
Q
;
SINGLE2(TEST,KSYN,MFICODE,MFECODE) ;Message for a single test
;TEST = IEN of lab test in file 60
;KSYN = IEN of synonym to be deleted from lab test in file 60
;MFICODE = File Level Event Code
;MFECODE = Record Level Event Code
N X,ORUPDMSG,MSG
S MSG="ORUPDMSG",X=$$MSH^LR7OU0("MFN"),ORUPDMSG(1)=X
S X=$$MFI(MFICODE),ORUPDMSG(2)=X
D TEST2(TEST,KSYN,2)
I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message
Q
;
TEST2(TEST,KSYN,ICNT) ;Process single test
;TEST = IEN of lab test in file 60
;KSYN = IEN of synonym to be deleted from lab test in file 60
;ICNT = Current counter in ORUPDMSG(ICNT)
N TYPE,TESTID,IFN,IFN1,CTR,CTR1,GENW,X0,S0,SAMP,MAX,DMAX,COLLECT,SAMPLE,SPEC,SYN,SUBID,COST,WCOM,Y9,Y10,Y11
Q:'$D(^LAB(60,TEST,0)) S X0=^(0),COST=$P(X0,"^",11),SUB=$P(X0,"^",4),TYPE=$P(X0,"^",3),CTR1=0
I $D(^LAB(60,TEST,6)) S (CTR,IFN)=0 F S IFN=$O(^LAB(60,TEST,6,IFN)) Q:IFN<1 S CTR=CTR+1,GENW(CTR)=^(IFN,0)
S (CTR,IFN)=0 F S IFN=$O(^LAB(60,TEST,5,IFN)) Q:IFN<1 D
. S:KSYN'=IFN CTR=CTR+1,SYN(CTR)=^LAB(60,TEST,5,IFN,0)
S (Y9,Y10,Y11)="" I $P($G(^LAB(60,TEST,64)),"^") S Y9=$P(^(64),"^"),Y10=$P(^LAM(Y9,0),"^"),Y9=$P(^(0),"^",2),Y11="99NLT"
D
. S (COLLECT,SAMP,SPEC)=0,TESTID=$$UVID^LR7OU0(TEST,+SPEC,Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)=$$MFE(MFECODE,TESTID)
. S ICNT=ICNT+1,ORUPDMSG(ICNT)=$$ZLR("","",CTR1,SUB,"","",COST,TYPE)
. S IFN1=0 F S IFN1=$O(^LAB(60,TEST,2,IFN1)) Q:IFN1<1 S X=^(IFN1,0) I $D(^LAB(60,+X,0)) D
.. N Y9,Y10,Y11 S (Y9,Y10,Y11)="" I $P($G(^LAB(60,+X,64)),"^") S Y9=$P(^(64),"^"),Y10=$P(^LAM(Y9,0),"^"),Y9=$P(^(0),"^",2),Y11="99NLT"
.. S SUBID=$$UVID^LR7OU0($P(X,"^"),"",Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)="ZLC||||"_SUBID
. D ZSY(.SYN),NTE(.GENW,.WCOM)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OV0 7728 printed Dec 13, 2024@02:05:55 Page 2
LR7OV0 ;DALOI/STAFF - Update orderable items ;Mar 16, 2021@16:42
+1 ;;5.2;LAB SERVICE;**121,187,357,361,350,434,543**;Sep 27, 1994;Build 7
+2 ;
+3 ;Reference to ^ORD(101.43 supported by DBIA #2843
+4 ;
TEST(TEST,ICNT) ;Process single test
+1 ;TEST=test ptr to file 60
+2 ;ICNT=Current counter in ORUPDMSG(ICNT)
+3 NEW TYPE,TESTID,IFN,IFN1,CTR,CTR1,GENW,X0,S0,SAMP,MAX,DMAX,COLLECT,SAMPLE,SPEC,SUBID,SYN,COST,WCOM,Y9,Y10,Y11
+4 if '$DATA(^LAB(60,TEST,0))
QUIT
SET X0=^(0)
SET COST=$PIECE(X0,"^",11)
SET SUB=$PIECE(X0,"^",4)
SET TYPE=$PIECE(X0,"^",3)
SET CTR1=0
+5 IF $DATA(^LAB(60,TEST,6))
SET (CTR,IFN)=0
FOR
SET IFN=$ORDER(^LAB(60,TEST,6,IFN))
if IFN<1
QUIT
SET CTR=CTR+1
SET GENW(CTR)=^(IFN,0)
+6 SET (CTR,IFN)=0
FOR
SET IFN=$ORDER(^LAB(60,TEST,5,IFN))
if IFN<1
QUIT
SET CTR=CTR+1
SET SYN(CTR)=^(IFN,0)
+7 SET (Y9,Y10,Y11)=""
IF $PIECE($GET(^LAB(60,TEST,64)),"^")
SET Y9=$PIECE(^(64),"^")
SET Y10=$PIECE(^LAM(Y9,0),"^")
SET Y9=$PIECE(^(0),"^",2)
SET Y11="99NLT"
+8 Begin DoDot:1
+9 SET (COLLECT,SAMP,SPEC)=0
SET TESTID=$$UVID^LR7OU0(TEST,+SPEC,Y9,Y11,Y10,"ORUPDMSG")
SET ICNT=ICNT+1
SET ORUPDMSG(ICNT)=$$MFE(MFECODE,TESTID)
+10 SET ICNT=ICNT+1
SET ORUPDMSG(ICNT)=$$ZLR("","",CTR1,SUB,"","",COST,TYPE)
+11 SET IFN1=0
FOR
SET IFN1=$ORDER(^LAB(60,TEST,2,IFN1))
if IFN1<1
QUIT
SET X=^(IFN1,0)
IF $DATA(^LAB(60,+X,0))
Begin DoDot:2
+12 NEW Y9,Y10,Y11
SET (Y9,Y10,Y11)=""
IF $PIECE($GET(^LAB(60,+X,64)),"^")
SET Y9=$PIECE(^(64),"^")
SET Y10=$PIECE(^LAM(Y9,0),"^")
SET Y9=$PIECE(^(0),"^",2)
SET Y11="99NLT"
+13 SET SUBID=$$UVID^LR7OU0($PIECE(X,"^"),"",Y9,Y11,Y10,"ORUPDMSG")
SET ICNT=ICNT+1
SET ORUPDMSG(ICNT)="ZLC||||"_SUBID
End DoDot:2
+14 DO ZSY(.SYN)
DO NTE(.GENW,.WCOM)
End DoDot:1
+15 QUIT
+16 ;
MFE(EVENT,KEY) ;MFE component
+1 ;EVENT=MAD-Add Record, MDL-Delete Record, MUP-Update Record
+2 ; MDC-Deactivate, MAC-Reactivate
+3 NEW MFE
+4 SET MFE="MFE|"_EVENT_"|||"_KEY
+5 QUIT MFE
+6 ;
ZLR(SPEC,COLLECT,SEQ,SUB,MAXORD,DMAXORD,COST,TYPE) ;ZLR component
+1 NEW ZLR
+2 SET ZLR="ZLR|"_SPEC_"|"_COLLECT_"|"_SEQ_"|"_SUB_"|"_MAXORD_"|"_DMAXORD_"|"_COST_"|"_TYPE
+3 QUIT ZLR
+4 ;
ZSY(SYN) ;ZSY component
+1 NEW IFN
+2 SET IFN=0
FOR
SET IFN=$ORDER(SYN(IFN))
if IFN<1
QUIT
SET ICNT=ICNT+1
SET ORUPDMSG(ICNT)="ZSY|"_IFN_"|"_SYN(IFN)
+3 QUIT
+4 ;
NTE(GEN,COM) ;NTE component
+1 NEW IFN,CTR
SET CTR=0
+2 SET ICNT=ICNT+1
DO NTE^LR7OU01(CTR,"P","GEN(",ICNT)
+3 SET ICNT=ICNT+1
DO NTE^LR7OU01(CTR,"P","COM(",ICNT)
+4 QUIT
+5 ;
MFI(EVENT) ;MFI component
+1 ;EVENT=REP for initial population of orderables
+2 ; =UPD for subsequent updates
+3 NEW MFI
+4 SET MFI="MFI|60^Lab Test^99DD||"_EVENT_"|||NE"
+5 QUIT MFI
+6 ;
SINGLE(TEST,MFICODE,MFECODE) ;Message for a single test
+1 ;TEST= ptr to test in file 60
+2 ;MFICODE=File Level Event Code
+3 ;MFECODE=Record Level Event Code
+4 ;N X,ORUPDMSG,MSG
+5 LOCK +LR7OV0(TEST):9999
+6 SET MSG="ORUPDMSG"
SET X=$$MSH^LR7OU0("MFN")
SET ORUPDMSG(1)=X
+7 SET X=$$MFI(MFICODE)
SET ORUPDMSG(2)=X
+8 DO TEST(TEST,2)
+9 ;W !!,$P(^LAB(60,TEST,0),"^"),! I $D(ORUPDMSG(3)) ZW ORUPDMSG
+10 ;
+11 ; If test deleted then mark file 101.43 entry as "inactive"
+12 IF '$DATA(^LAB(60,TEST,0))
Begin DoDot:1
+13 NEW TESTID
+14 SET MFECODE="MDC"
+15 SET TESTID=$$UVID^LR7OU0(TEST,0,"","","","ORUPDMSG")
+16 SET ORUPDMSG(3)=$$MFE(MFECODE,TESTID)
+17 ;LR*5.2*543: send mail message for manual correction
+18 DO MAIL
End DoDot:1
+19 ;Send update message
IF $DATA(ORUPDMSG(3))
SET ORUPDMSG="ORUPDMSG"
DO MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG)
+20 LOCK -LR7OV0(TEST)
+21 QUIT
+22 ;
MAIL ;
+1 ;LR*5.2*543
+2 NEW LR10143,LRNAME,LRMIN,LRMY,LRMSUB,LRMTEXT
+3 SET LR10143=$PIECE(TESTID,"^",4)_";"_$PIECE(TESTID,"^",6)
+4 SET LR10143=$ORDER(^ORD(101.43,"ID",LR10143,0))
+5 if LR10143']""
QUIT
+6 SET LRNAME=$PIECE($GET(^ORD(101.43,LR10143,0)),"^")
+7 ;Do not send message if name begins with "ZZ".
+8 ;Transaction has been sent to CPRS to mark the OI inactive, but it
+9 ;might not have filed yet. So no need to check for the inactive field.
+10 IF $EXTRACT(LRNAME,1,2)="ZZ"
QUIT
+11 SET LRMIN("FROM")="ORDERABLE ITEMS UPDATE TASK"
+12 SET LRMY(DUZ)=""
SET LRMY("G.LMI")=""
SET LRMY("G.OR CACS")=""
+13 SET LRMSUB="ATTENTION: Lab Test Deleted"
+14 SET LRMTEXT(1)="Lab test IEN: "_TEST_" ("_LRNAME_") has been deleted, but an orderable item"
+15 SET LRMTEXT(2)="(IEN: "_LR10143_") exists in the ORDERABLE ITEMS (#101.43) file."
+16 SET LRMTEXT(3)=" "
+17 SET LRMTEXT(4)="The orderable item should be edited to prefix the name with ""ZZ"" and"
+18 SET LRMTEXT(5)="make sure there is a date in the INACTIVATED (#.1) field."
+19 SET LRMTEXT="LRMTEXT"
+20 DO SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
+21 QUIT
+22 ;
ADD(TEST) ;Add single record to Master file
+1 NEW MFICODE,MFECODE
SET MFECODE="MAD"
SET MFICODE="REP"
DO SINGLE(TEST,MFICODE,MFECODE)
+2 QUIT
+3 ;
DEL(TEST) ;Delete single record from Master file
+1 NEW MFICODE,MFECODE
SET MFECODE="MDL"
SET MFICODE="UPD"
DO SINGLE(TEST,MFICODE,MFECODE)
+2 QUIT
+3 ;
UPD(TEST) ;Update record in Master file
+1 ;Modified for patch LR*5.2*361
+2 NEW ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO
+3 SET ZTSAVE("TEST")=TEST
+4 SET ZTRTN="TUPD^LR7OV0"
+5 SET ZTDESC="LABORATORY TEST FILE HL7 update message"
+6 SET ZTDTH=$HOROLOG
+7 SET ZTIO=""
+8 DO ^%ZTLOAD
+9 QUIT
+10 ;
TUPD ;Tasked update of record in Master file
+1 ;Added for patch LR*5.2*361
+2 NEW MFICODE,MFECODE
SET MFECODE="MUP"
SET MFICODE="UPD"
DO SINGLE(TEST,MFICODE,MFECODE)
+3 QUIT
+4 ;
DEACT(TEST) ;Deactivate record in Master file
+1 NEW MFICODE,MFECODE
SET MFECODE="MDC"
SET MFICODE="UPD"
DO SINGLE(TEST,MFICODE,MFECODE)
+2 QUIT
+3 ;
REACT(TEST) ;Reactivate record in Master file
+1 NEW MFICODE,MFECODE
SET MFECODE="MAC"
SET MFICODE="UPD"
DO SINGLE(TEST,MFICODE,MFECODE)
+2 QUIT
+3 ;
+4 ;Following code added to support LR*5.2*357
+5 ;Following code modified to support LR*5.2*361
+6 ;Designed to help update the ORDERABLE ITEMS FILE (file 101.43) after the deletion
+7 ;of a SYNONYM from the LABORATORY TEST file (file 60).
UPD2(TEST,KSYN) ;Update record in Master file - Modified for LR*5.2*361
+1 ;TEST = IEN of lab test in file 60
+2 ;KSYN = IEN of synonym to be deleted from lab test in file 60
+3 ;Modified for LR*5.2*361
+4 NEW ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO
+5 SET ZTSAVE("TEST")=TEST
+6 SET ZTSAVE("KSYN")=KSYN
+7 SET ZTRTN="TUPD2^LR7OV0"
+8 SET ZTDESC="LABORATORY TEST FILE HL7 update message"
+9 SET ZTDTH=$HOROLOG
+10 SET ZTIO=""
+11 DO ^%ZTLOAD
+12 QUIT
+13 ;
TUPD2 ;Update record in Master file
+1 ;TEST = IEN of lab test in file 60
+2 ;KSYN = IEN of synonym to be deleted from lab test in file 60
+3 NEW MFICODE,MFECODE
SET MFECODE="MUP"
SET MFICODE="UPD"
DO SINGLE2(TEST,KSYN,MFICODE,MFECODE)
+4 QUIT
+5 ;
SINGLE2(TEST,KSYN,MFICODE,MFECODE) ;Message for a single test
+1 ;TEST = IEN of lab test in file 60
+2 ;KSYN = IEN of synonym to be deleted from lab test in file 60
+3 ;MFICODE = File Level Event Code
+4 ;MFECODE = Record Level Event Code
+5 NEW X,ORUPDMSG,MSG
+6 SET MSG="ORUPDMSG"
SET X=$$MSH^LR7OU0("MFN")
SET ORUPDMSG(1)=X
+7 SET X=$$MFI(MFICODE)
SET ORUPDMSG(2)=X
+8 DO TEST2(TEST,KSYN,2)
+9 ;Send update message
IF $DATA(ORUPDMSG(3))
SET ORUPDMSG="ORUPDMSG"
DO MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG)
+10 QUIT
+11 ;
TEST2(TEST,KSYN,ICNT) ;Process single test
+1 ;TEST = IEN of lab test in file 60
+2 ;KSYN = IEN of synonym to be deleted from lab test in file 60
+3 ;ICNT = Current counter in ORUPDMSG(ICNT)
+4 NEW TYPE,TESTID,IFN,IFN1,CTR,CTR1,GENW,X0,S0,SAMP,MAX,DMAX,COLLECT,SAMPLE,SPEC,SYN,SUBID,COST,WCOM,Y9,Y10,Y11
+5 if '$DATA(^LAB(60,TEST,0))
QUIT
SET X0=^(0)
SET COST=$PIECE(X0,"^",11)
SET SUB=$PIECE(X0,"^",4)
SET TYPE=$PIECE(X0,"^",3)
SET CTR1=0
+6 IF $DATA(^LAB(60,TEST,6))
SET (CTR,IFN)=0
FOR
SET IFN=$ORDER(^LAB(60,TEST,6,IFN))
if IFN<1
QUIT
SET CTR=CTR+1
SET GENW(CTR)=^(IFN,0)
+7 SET (CTR,IFN)=0
FOR
SET IFN=$ORDER(^LAB(60,TEST,5,IFN))
if IFN<1
QUIT
Begin DoDot:1
+8 if KSYN'=IFN
SET CTR=CTR+1
SET SYN(CTR)=^LAB(60,TEST,5,IFN,0)
End DoDot:1
+9 SET (Y9,Y10,Y11)=""
IF $PIECE($GET(^LAB(60,TEST,64)),"^")
SET Y9=$PIECE(^(64),"^")
SET Y10=$PIECE(^LAM(Y9,0),"^")
SET Y9=$PIECE(^(0),"^",2)
SET Y11="99NLT"
+10 Begin DoDot:1
+11 SET (COLLECT,SAMP,SPEC)=0
SET TESTID=$$UVID^LR7OU0(TEST,+SPEC,Y9,Y11,Y10,"ORUPDMSG")
SET ICNT=ICNT+1
SET ORUPDMSG(ICNT)=$$MFE(MFECODE,TESTID)
+12 SET ICNT=ICNT+1
SET ORUPDMSG(ICNT)=$$ZLR("","",CTR1,SUB,"","",COST,TYPE)
+13 SET IFN1=0
FOR
SET IFN1=$ORDER(^LAB(60,TEST,2,IFN1))
if IFN1<1
QUIT
SET X=^(IFN1,0)
IF $DATA(^LAB(60,+X,0))
Begin DoDot:2
+14 NEW Y9,Y10,Y11
SET (Y9,Y10,Y11)=""
IF $PIECE($GET(^LAB(60,+X,64)),"^")
SET Y9=$PIECE(^(64),"^")
SET Y10=$PIECE(^LAM(Y9,0),"^")
SET Y9=$PIECE(^(0),"^",2)
SET Y11="99NLT"
+15 SET SUBID=$$UVID^LR7OU0($PIECE(X,"^"),"",Y9,Y11,Y10,"ORUPDMSG")
SET ICNT=ICNT+1
SET ORUPDMSG(ICNT)="ZLC||||"_SUBID
End DoDot:2
+16 DO ZSY(.SYN)
DO NTE(.GENW,.WCOM)
End DoDot:1
+17 QUIT
