Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LR7OV0

LR7OV0.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;Reference to ^ORD(101.43 supported by DBIA #2843
  1.  ;
  1. TEST(TEST,ICNT) ;Process single test
  1.  ;TEST=test ptr to file 60
  1.  ;ICNT=Current counter in ORUPDMSG(ICNT)
  1.  N TYPE,TESTID,IFN,IFN1,CTR,CTR1,GENW,X0,S0,SAMP,MAX,DMAX,COLLECT,SAMPLE,SPEC,SUBID,SYN,COST,WCOM,Y9,Y10,Y11
  1.  Q:'$D(^LAB(60,TEST,0))  S X0=^(0),COST=$P(X0,"^",11),SUB=$P(X0,"^",4),TYPE=$P(X0,"^",3),CTR1=0
  1.  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)
  1.  S (CTR,IFN)=0 F  S IFN=$O(^LAB(60,TEST,5,IFN)) Q:IFN<1  S CTR=CTR+1,SYN(CTR)=^(IFN,0)
  1.  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"
  1.  D
  1.  . S (COLLECT,SAMP,SPEC)=0,TESTID=$$UVID^LR7OU0(TEST,+SPEC,Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)=$$MFE(MFECODE,TESTID)
  1.  . S ICNT=ICNT+1,ORUPDMSG(ICNT)=$$ZLR("","",CTR1,SUB,"","",COST,TYPE)
  1.  . 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
  1.  .. 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"
  1.  .. S SUBID=$$UVID^LR7OU0($P(X,"^"),"",Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)="ZLC||||"_SUBID
  1.  . D ZSY(.SYN),NTE(.GENW,.WCOM)
  1.  Q
  1.  ;
  1. MFE(EVENT,KEY) ;MFE component
  1.  ;EVENT=MAD-Add Record, MDL-Delete Record, MUP-Update Record
  1.  ;      MDC-Deactivate, MAC-Reactivate
  1.  N MFE
  1.  S MFE="MFE|"_EVENT_"|||"_KEY
  1.  Q MFE
  1.  ;
  1. ZLR(SPEC,COLLECT,SEQ,SUB,MAXORD,DMAXORD,COST,TYPE) ;ZLR component
  1.  N ZLR
  1.  S ZLR="ZLR|"_SPEC_"|"_COLLECT_"|"_SEQ_"|"_SUB_"|"_MAXORD_"|"_DMAXORD_"|"_COST_"|"_TYPE
  1.  Q ZLR
  1.  ;
  1. ZSY(SYN) ;ZSY component
  1.  N IFN
  1.  S IFN=0 F  S IFN=$O(SYN(IFN)) Q:IFN<1  S ICNT=ICNT+1,ORUPDMSG(ICNT)="ZSY|"_IFN_"|"_SYN(IFN)
  1.  Q
  1.  ;
  1. NTE(GEN,COM) ;NTE component
  1.  N IFN,CTR S CTR=0
  1.  S ICNT=ICNT+1 D NTE^LR7OU01(CTR,"P","GEN(",ICNT)
  1.  S ICNT=ICNT+1 D NTE^LR7OU01(CTR,"P","COM(",ICNT)
  1.  Q
  1.  ;
  1. MFI(EVENT) ;MFI component
  1.  ;EVENT=REP for initial population of orderables
  1.  ;     =UPD for subsequent updates
  1.  N MFI
  1.  S MFI="MFI|60^Lab Test^99DD||"_EVENT_"|||NE"
  1.  Q MFI
  1.  ;
  1. SINGLE(TEST,MFICODE,MFECODE) ;Message for a single test
  1.  ;TEST= ptr to test in file 60
  1.  ;MFICODE=File Level Event Code
  1.  ;MFECODE=Record Level Event Code
  1.  ;N X,ORUPDMSG,MSG
  1.  L +LR7OV0(TEST):9999
  1.  S MSG="ORUPDMSG",X=$$MSH^LR7OU0("MFN"),ORUPDMSG(1)=X
  1.  S X=$$MFI(MFICODE),ORUPDMSG(2)=X
  1.  D TEST(TEST,2)
  1.  ;W !!,$P(^LAB(60,TEST,0),"^"),! I $D(ORUPDMSG(3)) ZW ORUPDMSG
  1.  ;
  1.  ; If test deleted then mark file 101.43 entry as "inactive"
  1.  I '$D(^LAB(60,TEST,0)) D
  1.  . N TESTID
  1.  . S MFECODE="MDC"
  1.  . S TESTID=$$UVID^LR7OU0(TEST,0,"","","","ORUPDMSG")
  1.  . S ORUPDMSG(3)=$$MFE(MFECODE,TESTID)
  1.  . ;LR*5.2*543: send mail message for manual correction
  1.  . D MAIL
  1.  I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message
  1.  L -LR7OV0(TEST)
  1.  Q
  1.  ;
  1. MAIL ;
  1.  ;LR*5.2*543
  1.  N LR10143,LRNAME,LRMIN,LRMY,LRMSUB,LRMTEXT
  1.  S LR10143=$P(TESTID,"^",4)_";"_$P(TESTID,"^",6)
  1.  S LR10143=$O(^ORD(101.43,"ID",LR10143,0))
  1.  Q:LR10143']""
  1.  S LRNAME=$P($G(^ORD(101.43,LR10143,0)),"^")
  1.  ;Do not send message if name begins with "ZZ".
  1.  ;Transaction has been sent to CPRS to mark the OI inactive, but it
  1.  ;might not have filed yet. So no need to check for the inactive field.
  1.  I $E(LRNAME,1,2)="ZZ" Q
  1.  S LRMIN("FROM")="ORDERABLE ITEMS UPDATE TASK"
  1.  S LRMY(DUZ)="",LRMY("G.LMI")="",LRMY("G.OR CACS")=""
  1.  S LRMSUB="ATTENTION: Lab Test Deleted"
  1.  S LRMTEXT(1)="Lab test IEN: "_TEST_" ("_LRNAME_") has been deleted, but an orderable item"
  1.  S LRMTEXT(2)="(IEN: "_LR10143_") exists in the ORDERABLE ITEMS (#101.43) file."
  1.  S LRMTEXT(3)=" "
  1.  S LRMTEXT(4)="The orderable item should be edited to prefix the name with ""ZZ"" and"
  1.  S LRMTEXT(5)="make sure there is a date in the INACTIVATED (#.1) field."
  1.  S LRMTEXT="LRMTEXT"
  1.  D SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
  1.  Q
  1.  ;
  1. ADD(TEST) ;Add single record to Master file
  1.  N MFICODE,MFECODE S MFECODE="MAD",MFICODE="REP" D SINGLE(TEST,MFICODE,MFECODE)
  1.  Q
  1.  ;
  1. DEL(TEST) ;Delete single record from Master file
  1.  N MFICODE,MFECODE S MFECODE="MDL",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
  1.  Q
  1.  ;
  1. UPD(TEST) ;Update record in Master file
  1.  ;Modified for patch LR*5.2*361
  1.  N ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO
  1.  S ZTSAVE("TEST")=TEST
  1.  S ZTRTN="TUPD^LR7OV0"
  1.  S ZTDESC="LABORATORY TEST FILE HL7 update message"
  1.  S ZTDTH=$H
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  Q
  1.  ;
  1. TUPD ;Tasked update of record in Master file
  1.  ;Added for patch LR*5.2*361
  1.  N MFICODE,MFECODE S MFECODE="MUP",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
  1.  Q
  1.  ;
  1. DEACT(TEST) ;Deactivate record in Master file
  1.  N MFICODE,MFECODE S MFECODE="MDC",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
  1.  Q
  1.  ;
  1. REACT(TEST) ;Reactivate record in Master file
  1.  N MFICODE,MFECODE S MFECODE="MAC",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
  1.  Q
  1.  ;
  1.  ;Following code added to support LR*5.2*357
  1.  ;Following code modified to support LR*5.2*361
  1.  ;Designed to help update the ORDERABLE ITEMS FILE (file 101.43) after the deletion
  1.  ;of a SYNONYM from the LABORATORY TEST file (file 60).
  1. UPD2(TEST,KSYN) ;Update record in Master file - Modified for LR*5.2*361
  1.  ;TEST = IEN of lab test in file 60
  1.  ;KSYN = IEN of synonym to be deleted from lab test in file 60
  1.  ;Modified for LR*5.2*361
  1.  N ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO
  1.  S ZTSAVE("TEST")=TEST
  1.  S ZTSAVE("KSYN")=KSYN
  1.  S ZTRTN="TUPD2^LR7OV0"
  1.  S ZTDESC="LABORATORY TEST FILE HL7 update message"
  1.  S ZTDTH=$H
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  Q
  1.  ;
  1. TUPD2 ;Update record in Master file
  1.  ;TEST = IEN of lab test in file 60
  1.  ;KSYN = IEN of synonym to be deleted from lab test in file 60
  1.  N MFICODE,MFECODE S MFECODE="MUP",MFICODE="UPD" D SINGLE2(TEST,KSYN,MFICODE,MFECODE)
  1.  Q
  1.  ;
  1. SINGLE2(TEST,KSYN,MFICODE,MFECODE) ;Message for a single test
  1.  ;TEST = IEN of lab test in file 60
  1.  ;KSYN = IEN of synonym to be deleted from lab test in file 60
  1.  ;MFICODE = File Level Event Code
  1.  ;MFECODE = Record Level Event Code
  1.  N X,ORUPDMSG,MSG
  1.  S MSG="ORUPDMSG",X=$$MSH^LR7OU0("MFN"),ORUPDMSG(1)=X
  1.  S X=$$MFI(MFICODE),ORUPDMSG(2)=X
  1.  D TEST2(TEST,KSYN,2)
  1.  I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message
  1.  Q
  1.  ;
  1. TEST2(TEST,KSYN,ICNT) ;Process single test
  1.  ;TEST = IEN of lab test in file 60
  1.  ;KSYN = IEN of synonym to be deleted from lab test in file 60
  1.  ;ICNT = Current counter in ORUPDMSG(ICNT)
  1.  N TYPE,TESTID,IFN,IFN1,CTR,CTR1,GENW,X0,S0,SAMP,MAX,DMAX,COLLECT,SAMPLE,SPEC,SYN,SUBID,COST,WCOM,Y9,Y10,Y11
  1.  Q:'$D(^LAB(60,TEST,0))  S X0=^(0),COST=$P(X0,"^",11),SUB=$P(X0,"^",4),TYPE=$P(X0,"^",3),CTR1=0
  1.  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)
  1.  S (CTR,IFN)=0 F  S IFN=$O(^LAB(60,TEST,5,IFN)) Q:IFN<1  D
  1.  . S:KSYN'=IFN CTR=CTR+1,SYN(CTR)=^LAB(60,TEST,5,IFN,0)
  1.  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"
  1.  D
  1.  . S (COLLECT,SAMP,SPEC)=0,TESTID=$$UVID^LR7OU0(TEST,+SPEC,Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)=$$MFE(MFECODE,TESTID)
  1.  . S ICNT=ICNT+1,ORUPDMSG(ICNT)=$$ZLR("","",CTR1,SUB,"","",COST,TYPE)
  1.  . 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
  1.  .. 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"
  1.  .. S SUBID=$$UVID^LR7OU0($P(X,"^"),"",Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)="ZLC||||"_SUBID
  1.  . D ZSY(.SYN),NTE(.GENW,.WCOM)
  1.  Q