Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LREVENT

LREVENT.m

Go to the documentation of this file.
  1. LREVENT ;DALIO/JMC - Shipping Event X-ref Utility ; [ 05/21/97 2:26 PM ]
  1. ;;5.2;LAB SERVICE;**153,286**;Sep 27, 1994
  1. Q
  1. ;
  1. ADT ; set logic for ADT x-ref in file 62.85
  1. N LRMAN S LRMAN=$P(^LAHM(62.85,DA,0),"^") Q:'$O(^LAHM(62.8,"B",LRMAN,0))
  1. S ^LAHM(62.85,"ADT",LRMAN,9999999-X,DA)=""
  1. Q
  1. ;
  1. ;
  1. KADT ; kill logic for ADT x-ref in file 62.85
  1. K ^LAHM(62.85,"ADT",$P(^LAHM(62.85,DA,0),"^"),9999999-X,DA)
  1. Q
  1. ;
  1. ;
  1. ATST ; set logic for ATST x-ref in file 62.85
  1. N LREVDT,LRUID S LREVDT=$P($G(^LAHM(62.85,DA,0)),"^",7) Q:'LREVDT
  1. S LRUID=$P(^LAHM(62.85,DA,0),"^") I $D(^LAHM(62.8,LRUID,0)) Q
  1. I X S ^LAHM(62.85,"ATST",LRUID,X,9999999-LREVDT,DA)=""
  1. Q
  1. ;
  1. ;
  1. KATST ; kill logic for ATST x-ref in file 62.85
  1. N LREVDT S LREVDT=$P($G(^LAHM(62.85,DA,0)),"^",7) Q:'LREVDT
  1. I X K ^LAHM(62.85,"ATST",$P(^LAHM(62.85,DA,0),"^"),X,9999999-LREVDT,DA)
  1. Q
  1. ;
  1. ;
  1. ATST1 ; set logic for ATST1 x-ref in file 62.85
  1. N LRTST,LRUID S LRTST=$P($G(^LAHM(62.85,DA,0)),"^",8) Q:'LRTST
  1. S LRUID=$P(^LAHM(62.85,DA,0),"^") I $D(^LAHM(62.8,LRUID,0)) Q
  1. S ^LAHM(62.85,"ATST",LRUID,LRTST,9999999-X,DA)=""
  1. Q
  1. ;
  1. ;
  1. KATST1 ; kill logic for ATST1 x-ref in file 62.85
  1. N LRTST S LRTST=$P($G(^LAHM(62.85,DA,0)),"^",8) Q:'LRTST
  1. K ^LAHM(62.85,"ATST",$P(^LAHM(62.85,DA,0),"^"),LRTST,9999999-X,DA)
  1. Q
  1. ;
  1. ;
  1. STATUS(LRUID,LRTSTN,LRMAN) ; return status of referral test
  1. ; Call with LRUID = accession's unique identifier (UID)
  1. ; LRTSTN = file #60 test ien
  1. ; LRMAN = manifest shipping #
  1. ;
  1. ; Returns LREVNT = status of referral testing.
  1. ;
  1. N LRAA,LRAD,LRAN,LRDA,LREVNT,LRIEN,LRINVDT,X
  1. ;
  1. S LREVNT=""
  1. I LRUID="" Q ""
  1. I LRMAN="" D
  1. . S X=$Q(^LRO(68,"C",LRUID)) Q:X=""
  1. . I $QS(X,3)'=LRUID Q
  1. . S LRAA=$QS(X,4),LRAD=$QS(X,5),LRAN=$QS(X,6)
  1. . S LRDA=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",LRTSTN,0)) Q:'LRDA
  1. . S X=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRDA,0),"^",10) Q:'X
  1. . S LRMAN=$P($G(^LAHM(62.8,X,0),"Manifest missing in file #62.8 with ien "_X),"^")
  1. ;
  1. S LRINVDT=$O(^LAHM(62.85,"ATST",LRUID,LRTSTN,0))
  1. I LRINVDT D
  1. . S LRIEN=$O(^LAHM(62.85,"ATST",LRUID,LRTSTN,LRINVDT,0))
  1. . I 'LRIEN Q
  1. . I LRMAN="" S LRMAN=$P(^LAHM(62.85,LRIEN,0),"^",9)
  1. . D EVENT
  1. ;
  1. I 'LRINVDT,LRMAN'="" D
  1. . S LRINVDT=$O(^LAHM(62.85,"ADT",LRMAN,0))
  1. . I 'LRINVDT Q
  1. . S LRIEN=$O(^LAHM(62.85,"ADT",LRMAN,LRINVDT,0))
  1. . I LRIEN D EVENT
  1. ;
  1. Q LREVNT
  1. ;
  1. ;
  1. EVENT ;
  1. N LRX
  1. S LRX=$P(^LAHM(62.85,LRIEN,0),"^",5)
  1. I LRX S $P(LREVNT,"^")=$$GET1^DIQ(62.85,LRIEN_",",.05)
  1. S LRX=$P(^LAHM(62.85,LRIEN,0),"^",7)
  1. I LRX S $P(LREVNT,"^",2)=$$FMTE^XLFDT(LRX,"MZ")
  1. S $P(LREVNT,"^",3)=LRMAN
  1. Q