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

LA7VMSG.m

Go to the documentation of this file. 
  1. LA7VMSG ;VA/DALOI/JMC - LAB ORU (Observation Result) message builder ;JUL 06, 2010 3:14 PM
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,50,56,46,64,1027**;NOV 01, 1997
  1.  ;
  1. ORU ; Bleed the ORU (Observation Result) message queue
  1.  ; Tasked by LRCAPV2
  1.  ;
  1.  N LA7MTYP
  1.  S LA7MTYP="ORU"
  1.  D START^LA7VMSG1
  1.  ;
  1.  Q
  1.  ;
  1. ORR ; Bleed the ORR (Order Response) message queue
  1.  ; Called by LRWLST12
  1.  ;
  1.  N LA7MTYP
  1.  S LA7MTYP="ORR"
  1.  ;D START^LA7VMSG1
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SET(LRUID,SITE,RUID,SITEN,ORD,LRNLT,LRIDT,LRSS,LRDFN,ORDT,LA7VCH,LA7MTYP) ; adds entries to LA7V QUEUE file
  1.  ; Called by LA7SRR, LRVER3, LRWLST12
  1.  ; variable list
  1.  ; LRUID - Host Unique ID from the local ACCESSION file (#68)
  1.  ; SITE  - remote sites IEN in INSTITUTION file (#4)
  1.  ; RUID  - Remote sites Unique ID from ACCESSION file (#68)
  1.  ; SITEN - Primary site number of remote site ($$SITE^VASITE)
  1.  ; ORD   - Free text ordered test name from WKLD CODE file (#64)
  1.  ; LRNLT - National Laboratory test code from WKLD CODE file (#64)
  1.  ; LRIDT - Inverse date/time (accession date/time)
  1.  ; LRSS  - test subscript defined in LABORATORY TEST file (#60)
  1.  ; LRDFN - IEN in LAB DATA file (#63)
  1.  ; ORDT  - Order date
  1.  ; LA7VCH (Optional) - array of Chemistry results
  1.  ;                     ex. glucose LA7VCH(2)=LR NODE
  1.  ;                                 LA7VCH(2,1)="C" (corrected results)
  1.  ; LA7MTYP (Optional) - Message Type (ORU or ORR) defaults to ORU
  1.  ;
  1.  N FDA,LA76248,LA76249,LA7DT,LA7FACID,LA7ERR,LA7RSITE,LA7Y,PORD,PORT,RSITE
  1.  ;
  1.  S LA7ERR=0
  1.  I $G(LA7MTYP)="" S LA7MTYP="ORU"
  1.  ; Currently not building ORR when accessioning - JMC/7/11/00
  1.  I LA7MTYP="ORR" Q
  1.  ;
  1.  ; Retrieve facility id (VA=station number, DoD=DMIS code, other=local site assigned id)
  1.  S LA7FACID=$$RETFACID^LA7VHLU2(SITEN,2,1),LA76248=0
  1.  S LA7RSITE="LA7V COLLECTION "_LA7FACID
  1.  S LA76248=$O(^LAHM(62.48,"B",LA7RSITE,0))
  1.  ; No entry in 62.48 - *** Need to add error logging ****
  1.  I 'LA76248 Q
  1.  I '$P(^LAHM(62.48,LA76248,0),"^",3) Q  ; not active
  1.  ;
  1.  ; Create new outgoing entry in 62.49
  1.  S LA76249=$$INIT6249^LA7VHLU
  1.  I LA76249<1 D  Q
  1.  . ; Log entry creation error
  1.  ;
  1.  ; Check/validate parameters before storing
  1.  ; If error store but flag entry with error status.
  1.  D CHKACC
  1.  ;
  1.  ; File data
  1.  S FDA(1,62.49,LA76249_",",1)="O"
  1.  S FDA(1,62.49,LA76249_",",.5)=LA76248
  1.  S FDA(1,62.49,LA76249_",",2)=$S(LA7ERR:"E",1:"P")
  1.  S FDA(1,62.49,LA76249_",",5)=LA7RSITE_"-O-"_RUID
  1.  S FDA(1,62.49,LA76249_",",108)=LA7MTYP
  1.  S FDA(1,62.49,LA76249_",",151)=LRUID
  1.  S FDA(1,62.49,LA76249_",",152)=SITEN
  1.  S FDA(1,62.49,LA76249_",",153)=RUID
  1.  S FDA(1,62.49,LA76249_",",154)=ORD
  1.  S FDA(1,62.49,LA76249_",",155)=LRNLT
  1.  S FDA(1,62.49,LA76249_",",156)=LRIDT
  1.  S FDA(1,62.49,LA76249_",",157)=LRSS
  1.  S FDA(1,62.49,LA76249_",",158)=LRDFN
  1.  S FDA(1,62.49,LA76249_",",159)=ORDT
  1.  ;
  1.  D FILE^DIE("","FDA(1)","LA7ERR(1)")
  1.  D CLEAN^DILF
  1.  ;
  1.  ; Add test to order
  1.  S LA7Y=0
  1.  F  S LA7Y=$O(LA7VCH(LA7Y)) Q:'LA7Y  D
  1.  . N FDAIEN
  1.  . S FDA(2,62.49162,"+2,"_LA76249_",",.01)=LA7Y
  1.  . I $G(LA7VCH(LA7Y,1))="C" S FDA(2,62.49162,"+2,"_LA76249_",",.02)="C"
  1.  . S FDAIEN(1)=LA76249
  1.  . D UPDATE^DIE("","FDA(2)","FDAIEN","LA7ERR(2)")
  1.  . D CLEAN^DILF
  1.  ;
  1.  ; Release lock on entry.
  1.  L -^LAHM(62.49,LA76249)
  1.  Q
  1.  ;
  1.  ;
  1. CHKACC ; Check/validate parameters passed in before storing in file #62.49
  1.  ;
  1.  N I,LA763,LA768,LA7AA,LA7AD,LA7AN
  1.  ;
  1.  I $G(LRUID)="",$G(RUID)="" Q
  1.  I LRUID'="",'$D(^LRO(68,"C",LRUID)) D
  1.  . S LRUID=$G(RUID)
  1.  . I LRUID'="",'$D(^LRO(68,"C",LRUID)) S LRUID=""
  1.  I LRUID="" Q
  1.  ;
  1.  S I=$Q(^LRO(68,"C",LRUID)),(LA7AA,LA7AD,LA7AN)=0
  1.  I I'="",$QS(I,3)=LRUID S LA7AA=$QS(I,4),LA7AD=$QS(I,5),LA7AN=$QS(I,6)
  1.  F I=0,.2,.3,3 S LA768(I)=$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,I))
  1.  ;
  1.  F I=0,"ORU" S LA763(I)=$G(^LR(LRDFN,LRSS,LRIDT,I))
  1.  ;
  1.  ; Mismatch on subscript with file #68
  1.  I LRSS'=$P(^LRO(68,LA7AA,0),"^",2) S LA7ERR=40 D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  ; Mismatch on LRDFN with file #68
  1.  I LRDFN'=$P(LA768(0),"^") S LA7ERR=41 D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  ; Mismatch on specimen inverse d/t with file #68
  1.  I LRIDT'=$P(LA768(3),"^",5) S LA7ERR=42 D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  ; Mismatch on remote UID with file #68
  1.  I $G(RUID)'="",RUID'=$P(LA768(.3),"^",5) S LA7ERR=43 D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  ; Mismatch on remote UID with file #63
  1.  I $G(RUID)'="",$P(LA763("ORU"),"^",5)'="",RUID'=$P(LA763("ORU"),"^",5) S LA7ERR=44 D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  ; Mismatch on UID between file #63 and file #68
  1.  I $P(LA768(.3),"^")'="",$P(LA763("ORU"),"^")'="",$P(LA768(.3),"^")'=$P(LA763("ORU"),"^") S LA7ERR=45 D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. ACK ; ACKnowledgment message processor
  1.  ;
  1.  G ACK^LA7VHL
  1.  Q
  1.  ;
  1.  ;
  1. TRIGGER(LRAA,LRAD,LRAN,LRTS) ; Call with LRTS by reference
  1.  ; LRTS array contains a list of verified test.
  1.  ; Sets the queue for out going messages. ^LAHM(62.49
  1.  ;
  1.  N ERR,LRDFN,LREND,LRIDT,LRNIEN,LRNLT,LRNLTN,LRODT,LRSS,LRTSX
  1.  N LRORU3,LRX
  1.  S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRODT=+$P(^(0),U,4)
  1.  S LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5)
  1.  S LRSS=$P($G(^LRO(68,LRAA,0)),U,2)
  1.  S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
  1.  Q:'$P($G(LRORU3),U,2)!('LRIDT)
  1.  Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))#2
  1.  ;
  1.  S LRX=0 F  S LRX=$O(LRTS(LRX)) Q:'LRX  D
  1.  . S LRNLT=+$G(^LAB(60,+LRTS(LRX),64)) Q:'LRNLT
  1.  . Q:'$D(^LAM(LRNLT,0))#2
  1.  . S LRNLTN=$P(^LAM(LRNLT,0),U),LRNLT=$P(^(0),U,2)
  1.  . Q:'LRNLT
  1.  . D SET($P(LRORU3,U,4),$P(LRORU3,U,2),$P(LRORU3,U,5),$P(LRORU3,U,3),LRNLTN,LRNLT,LRIDT,LRSS,LRDFN,LRODT,"","ORU")
  1.  Q