source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OV0.m@ 1540

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

initial load of FOIAVistA 6/30/08 version

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
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 ;TEST= ptr to test in file 60
44 ;MFICODE=File Level Event Code
45 ;MFECODE=Record Level Event Code
46 ;N X,ORUPDMSG,MSG
47 S MSG="ORUPDMSG",X=$$MSH^LR7OU0("MFN"),ORUPDMSG(1)=X
48 S X=$$MFI(MFICODE),ORUPDMSG(2)=X
49 D TEST(TEST,2)
50 ;W !!,$P(^LAB(60,TEST,0),"^"),! I $D(ORUPDMSG(3)) ZW ORUPDMSG
51 I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message
52 Q
53ADD(TEST) ;Add single record to Master file
54 N MFICODE,MFECODE S MFECODE="MAD",MFICODE="REP" D SINGLE(TEST,MFICODE,MFECODE)
55 Q
56DEL(TEST) ;Delete single record from Master file
57 N MFICODE,MFECODE S MFECODE="MDL",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
58 Q
59UPD(TEST) ;Update record in Master file
60 ;Modified for patch LR*5.2*361
61 N ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO
62 S ZTSAVE("TEST")=TEST
63 S ZTRTN="TUPD^LR7OV0"
64 S ZTDESC="LABORATORY TEST FILE HL7 update message"
65 S ZTDTH=$H
66 S ZTIO=""
67 D ^%ZTLOAD
68 Q
69TUPD ;Tasked update of record in Master file
70 ;Added for patch LR*5.2*361
71 N MFICODE,MFECODE S MFECODE="MUP",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
72 Q
73DEACT(TEST) ;Deactivate record in Master file
74 N MFICODE,MFECODE S MFECODE="MDC",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
75 Q
76REACT(TEST) ;Reactivate record in Master file
77 N MFICODE,MFECODE S MFECODE="MAC",MFICODE="UPD" D SINGLE(TEST,MFICODE,MFECODE)
78 Q
79 ;Following code added to support LR*5.2*357
80 ;Following code modified to support LR*5.2*361
81 ;Designed to help update the ORDERABLE ITEMS FILE (file 101.43) after the deletion
82 ;of a SYNONYM from the LABORATORY TEST file (file 60).
83UPD2(TEST,KSYN) ;Update record in Master file - Modified for LR*5.2*361
84 ;TEST = IEN of lab test in file 60
85 ;KSYN = IEN of synonym to be deleted from lab test in file 60
86 ;Modified for LR*5.2*361
87 N ZTSAVE,ZTRTN,ZTDESC,ZTDTH,ZTIO
88 S ZTSAVE("TEST")=TEST
89 S ZTSAVE("KSYN")=KSYN
90 S ZTRTN="TUPD2^LR7OV0"
91 S ZTDESC="LABORATORY TEST FILE HL7 update message"
92 S ZTDTH=$H
93 S ZTIO=""
94 D ^%ZTLOAD
95 Q
96TUPD2 ;Update record in Master file
97 ;TEST = IEN of lab test in file 60
98 ;KSYN = IEN of synonym to be deleted from lab test in file 60
99 N MFICODE,MFECODE S MFECODE="MUP",MFICODE="UPD" D SINGLE2(TEST,KSYN,MFICODE,MFECODE)
100 Q
101SINGLE2(TEST,KSYN,MFICODE,MFECODE) ;Message for a single test
102 ;TEST = IEN of lab test in file 60
103 ;KSYN = IEN of synonym to be deleted from lab test in file 60
104 ;MFICODE = File Level Event Code
105 ;MFECODE = Record Level Event Code
106 N X,ORUPDMSG,MSG
107 S MSG="ORUPDMSG",X=$$MSH^LR7OU0("MFN"),ORUPDMSG(1)=X
108 S X=$$MFI(MFICODE),ORUPDMSG(2)=X
109 D TEST2(TEST,KSYN,2)
110 I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message
111 Q
112TEST2(TEST,KSYN,ICNT) ;Process single test
113 ;TEST = IEN of lab test in file 60
114 ;KSYN = IEN of synonym to be deleted from lab test in file 60
115 ;ICNT = Current counter in ORUPDMSG(ICNT)
116 N TYPE,TESTID,IFN,IFN1,CTR,CTR1,GENW,X0,S0,SAMP,MAX,DMAX,COLLECT,SAMPLE,SPEC,SYN,COST,Y9,Y10,Y11
117 Q:'$D(^LAB(60,TEST,0)) S X0=^(0),COST=$P(X0,"^",11),SUB=$P(X0,"^",4),TYPE=$P(X0,"^",3),CTR1=0
118 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)
119 S (CTR,IFN)=0 F S IFN=$O(^LAB(60,TEST,5,IFN)) Q:IFN<1 D
120 . S:KSYN'=IFN CTR=CTR+1,SYN(CTR)=^LAB(60,TEST,5,IFN,0)
121 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"
122 D
123 . S (COLLECT,SAMP,SPEC)=0,TESTID=$$UVID^LR7OU0(TEST,+SPEC,Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)=$$MFE(MFECODE,TESTID)
124 . S ICNT=ICNT+1,ORUPDMSG(ICNT)=$$ZLR("","",CTR1,SUB,"","",COST,TYPE)
125 . 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
126 .. 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"
127 .. S SUBID=$$UVID^LR7OU0($P(X,"^"),"",Y9,Y11,Y10,"ORUPDMSG"),ICNT=ICNT+1,ORUPDMSG(ICNT)="ZLC||||"_SUBID
128 . D ZSY(.SYN),NTE(.GENW,.WCOM)
129 Q
Note: See TracBrowser for help on using the repository browser.