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 ;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
  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,SYN,COST,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. MFE(EVENT,KEY) ;MFE component
  1.  ;EVENT=MAD-Add Record, MDL-Delete Record, MUP-Update Record
  1.  ;      MDC-Deactivate, MAC-Reactivate
  1.  S MFE="MFE|"_EVENT_"|||"_KEY
  1.  Q MFE
  1. ZLR(SPEC,COLLECT,SEQ,SUB,MAXORD,DMAXORD,COST,TYPE) ;ZLR component
  1.  S ZLR="ZLR|"_SPEC_"|"_COLLECT_"|"_SEQ_"|"_SUB_"|"_MAXORD_"|"_DMAXORD_"|"_COST_"|"_TYPE
  1.  Q ZLR
  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. 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. MFI(EVENT) ;MFI component
  1.  ;EVENT=REP for initial population of orderables
  1.  ;     =UPD for subsequent updates
  1.  S MFI="MFI|60^Lab Test^99DD||"_EVENT_"|||NE"
  1.  Q MFI
  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.  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.  I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message
  1.  Q
  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. 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. 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. 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. DEACT(TEST) ;Deactivate record in Master file
  1.  N MFICODE,MFECODE S MFECODE="MDC",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
  1.  Q
  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.  ;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. 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. 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. 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,COST,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