source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LREVENT.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: 2.5 KB
Line 
1LREVENT ;DALIO/JMC - Shipping Event X-ref Utility ; [ 05/21/97 2:26 PM ]
2 ;;5.2;LAB SERVICE;**153,286**;Sep 27, 1994
3 Q
4 ;
5ADT ; set logic for ADT x-ref in file 62.85
6 N LRMAN S LRMAN=$P(^LAHM(62.85,DA,0),"^") Q:'$O(^LAHM(62.8,"B",LRMAN,0))
7 S ^LAHM(62.85,"ADT",LRMAN,9999999-X,DA)=""
8 Q
9 ;
10 ;
11KADT ; kill logic for ADT x-ref in file 62.85
12 K ^LAHM(62.85,"ADT",$P(^LAHM(62.85,DA,0),"^"),9999999-X,DA)
13 Q
14 ;
15 ;
16ATST ; set logic for ATST x-ref in file 62.85
17 N LREVDT,LRUID S LREVDT=$P($G(^LAHM(62.85,DA,0)),"^",7) Q:'LREVDT
18 S LRUID=$P(^LAHM(62.85,DA,0),"^") I $D(^LAHM(62.8,LRUID,0)) Q
19 I X S ^LAHM(62.85,"ATST",LRUID,X,9999999-LREVDT,DA)=""
20 Q
21 ;
22 ;
23KATST ; kill logic for ATST x-ref in file 62.85
24 N LREVDT S LREVDT=$P($G(^LAHM(62.85,DA,0)),"^",7) Q:'LREVDT
25 I X K ^LAHM(62.85,"ATST",$P(^LAHM(62.85,DA,0),"^"),X,9999999-LREVDT,DA)
26 Q
27 ;
28 ;
29ATST1 ; set logic for ATST1 x-ref in file 62.85
30 N LRTST,LRUID S LRTST=$P($G(^LAHM(62.85,DA,0)),"^",8) Q:'LRTST
31 S LRUID=$P(^LAHM(62.85,DA,0),"^") I $D(^LAHM(62.8,LRUID,0)) Q
32 S ^LAHM(62.85,"ATST",LRUID,LRTST,9999999-X,DA)=""
33 Q
34 ;
35 ;
36KATST1 ; kill logic for ATST1 x-ref in file 62.85
37 N LRTST S LRTST=$P($G(^LAHM(62.85,DA,0)),"^",8) Q:'LRTST
38 K ^LAHM(62.85,"ATST",$P(^LAHM(62.85,DA,0),"^"),LRTST,9999999-X,DA)
39 Q
40 ;
41 ;
42STATUS(LRUID,LRTSTN,LRMAN) ; return status of referral test
43 ; Call with LRUID = accession's unique identifier (UID)
44 ; LRTSTN = file #60 test ien
45 ; LRMAN = manifest shipping #
46 ;
47 ; Returns LREVNT = status of referral testing.
48 ;
49 N LRAA,LRAD,LRAN,LRDA,LREVNT,LRIEN,LRINVDT,X
50 ;
51 S LREVNT=""
52 I LRUID="" Q ""
53 I LRMAN="" D
54 . S X=$Q(^LRO(68,"C",LRUID)) Q:X=""
55 . I $QS(X,3)'=LRUID Q
56 . S LRAA=$QS(X,4),LRAD=$QS(X,5),LRAN=$QS(X,6)
57 . S LRDA=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",LRTSTN,0)) Q:'LRDA
58 . S X=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRDA,0),"^",10) Q:'X
59 . S LRMAN=$P($G(^LAHM(62.8,X,0),"Manifest missing in file #62.8 with ien "_X),"^")
60 ;
61 S LRINVDT=$O(^LAHM(62.85,"ATST",LRUID,LRTSTN,0))
62 I LRINVDT D
63 . S LRIEN=$O(^LAHM(62.85,"ATST",LRUID,LRTSTN,LRINVDT,0))
64 . I 'LRIEN Q
65 . I LRMAN="" S LRMAN=$P(^LAHM(62.85,LRIEN,0),"^",9)
66 . D EVENT
67 ;
68 I 'LRINVDT,LRMAN'="" D
69 . S LRINVDT=$O(^LAHM(62.85,"ADT",LRMAN,0))
70 . I 'LRINVDT Q
71 . S LRIEN=$O(^LAHM(62.85,"ADT",LRMAN,LRINVDT,0))
72 . I LRIEN D EVENT
73 ;
74 Q LREVNT
75 ;
76 ;
77EVENT ;
78 N LRX
79 S LRX=$P(^LAHM(62.85,LRIEN,0),"^",5)
80 I LRX S $P(LREVNT,"^")=$$GET1^DIQ(62.85,LRIEN_",",.05)
81 S LRX=$P(^LAHM(62.85,LRIEN,0),"^",7)
82 I LRX S $P(LREVNT,"^",2)=$$FMTE^XLFDT(LRX,"MZ")
83 S $P(LREVNT,"^",3)=LRMAN
84 Q
Note: See TracBrowser for help on using the repository browser.