| [613] | 1 | LREVENT ;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 | ;
|
|---|
| 5 | ADT ; 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 | ;
|
|---|
| 11 | KADT ; 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 | ;
|
|---|
| 16 | ATST ; 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 | ;
|
|---|
| 23 | KATST ; 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 | ;
|
|---|
| 29 | ATST1 ; 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 | ;
|
|---|
| 36 | KATST1 ; 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 | ;
|
|---|
| 42 | STATUS(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 | ;
|
|---|
| 77 | EVENT ;
|
|---|
| 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
|
|---|
