LR7OV0 ;VA/slc/dcm - Update orderable items ;JUL 06, 2010 3:14 PM
;;5.2;LAB SERVICE;**121,187,357,361,1027**;NOV 01, 1997
;
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,SYN,COST,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
S MFE="MFE|"_EVENT_"|||"_KEY
Q MFE
ZLR(SPEC,COLLECT,SEQ,SUB,MAXORD,DMAXORD,COST,TYPE) ;ZLR component
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
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
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
I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message
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,COST,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
LR7OV0 ;VA/slc/dcm - Update orderable items ;JUL 06, 2010 3:14 PM
+1 ;;5.2;LAB SERVICE;**121,187,357,361,1027**;NOV 01, 1997
+2 ;
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,SYN,COST,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
MFE(EVENT,KEY) ;MFE component
+1 ;EVENT=MAD-Add Record, MDL-Delete Record, MUP-Update Record
+2 ; MDC-Deactivate, MAC-Reactivate
+3 SET MFE="MFE|"_EVENT_"|||"_KEY
+4 QUIT MFE
ZLR(SPEC,COLLECT,SEQ,SUB,MAXORD,DMAXORD,COST,TYPE) ;ZLR component
+1 SET ZLR="ZLR|"_SPEC_"|"_COLLECT_"|"_SEQ_"|"_SUB_"|"_MAXORD_"|"_DMAXORD_"|"_COST_"|"_TYPE
+2 QUIT ZLR
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
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
MFI(EVENT) ;MFI component
+1 ;EVENT=REP for initial population of orderables
+2 ; =UPD for subsequent updates
+3 SET MFI="MFI|60^Lab Test^99DD||"_EVENT_"|||NE"
+4 QUIT MFI
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 SET MSG="ORUPDMSG"
SET X=$$MSH^LR7OU0("MFN")
SET ORUPDMSG(1)=X
+6 SET X=$$MFI(MFICODE)
SET ORUPDMSG(2)=X
+7 DO TEST(TEST,2)
+8 ;W !!,$P(^LAB(60,TEST,0),"^"),! I $D(ORUPDMSG(3)) ZW ORUPDMSG
+9 ;Send update message
IF $DATA(ORUPDMSG(3))
SET ORUPDMSG="ORUPDMSG"
DO MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG)
+10 QUIT
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
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
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
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
DEACT(TEST) ;Deactivate record in Master file
+1 NEW MFICODE,MFECODE
SET MFECODE="MDC"
SET MFICODE="UPD"
DO SINGLE(TEST,MFICODE,MFECODE)
+2 QUIT
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 ;Following code added to support LR*5.2*357
+4 ;Following code modified to support LR*5.2*361
+5 ;Designed to help update the ORDERABLE ITEMS FILE (file 101.43) after the deletion
+6 ;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
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
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
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,COST,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
