source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OV0.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1LR7OV0 ;slc/dcm - Update orderable items ;8/11/97
2 ;;5.2;LAB SERVICE;**121,187,357,361**;Sep 27, 1994;Build 2
3 ;
4TEST(TEST,ICNT) ;Process single test
5 ;TEST=test ptr to file 60
6 ;ICNT=Current counter in ORUPDMSG(ICNT)
7 N TYPE,TESTID,IFN,IFN1,CTR,CTR1,GENW,X0,S0,SAMP,MAX,DMAX,COLLECT,SAMPLE,SPEC,SYN,COST,Y9,Y10,Y11
8 Q:'$D(^LAB(60,TEST,0)) S X0=^(0),COST=$P(X0,"^",11),SUB=$P(X0,"^",4),TYPE=$P(X0,"^",3),CTR1=0
9 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)
10 S (CTR,IFN)=0 F S IFN=$O(^LAB(60,TEST,5,IFN)) Q:IFN<1 S CTR=CTR+1,SYN(CTR)=^(IFN,0)
11 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"
12 D
13 . S (COLLECT,SAMP,SPEC)=0,TESTID=$$UVID^LR7OU0(TEST,+SPEC,Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)=$$MFE(MFECODE,TESTID)
14 . S ICNT=ICNT+1,ORUPDMSG(ICNT)=$$ZLR("","",CTR1,SUB,"","",COST,TYPE)
15 . 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
16 .. 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"
17 .. S SUBID=$$UVID^LR7OU0($P(X,"^"),"",Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)="ZLC||||"_SUBID
18 . D ZSY(.SYN),NTE(.GENW,.WCOM)
19 Q
20MFE(EVENT,KEY) ;MFE component
21 ;EVENT=MAD-Add Record, MDL-Delete Record, MUP-Update Record
22 ; MDC-Deactivate, MAC-Reactivate
23 S MFE="MFE|"_EVENT_"|||"_KEY
24 Q MFE
25ZLR(SPEC,COLLECT,SEQ,SUB,MAXORD,DMAXORD,COST,TYPE) ;ZLR component
26 S ZLR="ZLR|"_SPEC_"|"_COLLECT_"|"_SEQ_"|"_SUB_"|"_MAXORD_"|"_DMAXORD_"|"_COST_"|"_TYPE
27 Q ZLR
28ZSY(SYN) ;ZSY component
29 N IFN
30 S IFN=0 F S IFN=$O(SYN(IFN)) Q:IFN<1 S ICNT=ICNT+1,ORUPDMSG(ICNT)="ZSY|"_IFN_"|"_SYN(IFN)
31 Q
32NTE(GEN,COM) ;NTE component
33 N IFN,CTR S CTR=0
34 S ICNT=ICNT+1 D NTE^LR7OU01(CTR,"P","GEN(",ICNT)
35 S ICNT=ICNT+1 D NTE^LR7OU01(CTR,"P","COM(",ICNT)
36 Q
37MFI(EVENT) ;MFI component
38 ;EVENT=REP for initial population of orderables
39 ; =UPD for subsequent updates
40 S MFI="MFI|60^Lab Test^99DD||"_EVENT_"|||NE"
41 Q MFI
42SINGLE(TEST,MFICODE,MFECODE) ;Message for a single test
43 L +LR7OV0(TEST)
44 ;TEST= ptr to test in file 60
45 ;MFICODE=File Level Event Code
46 ;MFECODE=Record Level Event Code
47 ;N X,ORUPDMSG,MSG
48 S MSG="ORUPDMSG",X=$$MSH^LR7OU0("MFN"),ORUPDMSG(1)=X
49 S X=$$MFI(MFICODE),ORUPDMSG(2)=X
50 D TEST(TEST,2)
51 ;W !!,$P(^LAB(60,TEST,0),"^"),! I $D(ORUPDMSG(3)) ZW ORUPDMSG
52 I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message
53 L -LR7OV0(TEST)
54 Q
55ADD(TEST) ;Add single record to Master file
56 N MFICODE,MFECODE S MFECODE="MAD",MFICODE="REP" D SINGLE(TEST,MFICODE,MFECODE)
57 Q
58DEL(TEST) ;Delete single record from Master file
59 N MFICODE,MFECODE S MFECODE="MDL",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
60 Q
61UPD(TEST) ;Update record in Master file
62 ;Modified for patch LR*5.2*361
63 N ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO
64 S ZTSAVE("TEST")=TEST
65 S ZTRTN="TUPD^LR7OV0"
66 S ZTDESC="LABORATORY TEST FILE HL7 update message"
67 S ZTDTH=$H
68 S ZTIO=""
69 D ^%ZTLOAD
70 Q
71TUPD ;Tasked update of record in Master file
72 ;Added for patch LR*5.2*361
73 N MFICODE,MFECODE S MFECODE="MUP",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
74 Q
75DEACT(TEST) ;Deactivate record in Master file
76 N MFICODE,MFECODE S MFECODE="MDC",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
77 Q
78REACT(TEST) ;Reactivate record in Master file
79 N MFICODE,MFECODE S MFECODE="MAC",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
80 Q
81 ;Following code added to support LR*5.2*357
82 ;Following code modified to support LR*5.2*361
83 ;Designed to help update the ORDERABLE ITEMS FILE (file 101.43) after the deletion
84 ;of a SYNONYM from the LABORATORY TEST file (file 60).
85UPD2(TEST,KSYN) ;Update record in Master file - Modified for LR*5.2*361
86 ;TEST = IEN of lab test in file 60
87 ;KSYN = IEN of synonym to be deleted from lab test in file 60
88 ;Modified for LR*5.2*361
89 N ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO
90 S ZTSAVE("TEST")=TEST
91 S ZTSAVE("KSYN")=KSYN
92 S ZTRTN="TUPD2^LR7OV0"
93 S ZTDESC="LABORATORY TEST FILE HL7 update message"
94 S ZTDTH=$H
95 S ZTIO=""
96 D ^%ZTLOAD
97 Q
98TUPD2 ;Update record in Master file
99 ;TEST = IEN of lab test in file 60
100 ;KSYN = IEN of synonym to be deleted from lab test in file 60
101 N MFICODE,MFECODE S MFECODE="MUP",MFICODE="UPD" D SINGLE2(TEST,KSYN,MFICODE,MFECODE)
102 Q
103SINGLE2(TEST,KSYN,MFICODE,MFECODE) ;Message for a single test
104 ;TEST = IEN of lab test in file 60
105 ;KSYN = IEN of synonym to be deleted from lab test in file 60
106 ;MFICODE = File Level Event Code
107 ;MFECODE = Record Level Event Code
108 N X,ORUPDMSG,MSG
109 S MSG="ORUPDMSG",X=$$MSH^LR7OU0("MFN"),ORUPDMSG(1)=X
110 S X=$$MFI(MFICODE),ORUPDMSG(2)=X
111 D TEST2(TEST,KSYN,2)
112 I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message
113 Q
114TEST2(TEST,KSYN,ICNT) ;Process single test
115 ;TEST = IEN of lab test in file 60
116 ;KSYN = IEN of synonym to be deleted from lab test in file 60
117 ;ICNT = Current counter in ORUPDMSG(ICNT)
118 N TYPE,TESTID,IFN,IFN1,CTR,CTR1,GENW,X0,S0,SAMP,MAX,DMAX,COLLECT,SAMPLE,SPEC,SYN,COST,Y9,Y10,Y11
119 Q:'$D(^LAB(60,TEST,0)) S X0=^(0),COST=$P(X0,"^",11),SUB=$P(X0,"^",4),TYPE=$P(X0,"^",3),CTR1=0
120 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)
121 S (CTR,IFN)=0 F S IFN=$O(^LAB(60,TEST,5,IFN)) Q:IFN<1 D
122 . S:KSYN'=IFN CTR=CTR+1,SYN(CTR)=^LAB(60,TEST,5,IFN,0)
123 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"
124 D
125 . S (COLLECT,SAMP,SPEC)=0,TESTID=$$UVID^LR7OU0(TEST,+SPEC,Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)=$$MFE(MFECODE,TESTID)
126 . S ICNT=ICNT+1,ORUPDMSG(ICNT)=$$ZLR("","",CTR1,SUB,"","",COST,TYPE)
127 . 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
128 .. 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"
129 .. S SUBID=$$UVID^LR7OU0($P(X,"^"),"",Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)="ZLC||||"_SUBID
130 . D ZSY(.SYN),NTE(.GENW,.WCOM)
131 Q
Note: See TracBrowser for help on using the repository browser.