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

LA7CHDR.m

Go to the documentation of this file. 
  1. LA7CHDR ;VA/DALOI/JMC - LAB HDR ORU (Observation Result) message builder ; 22-Oct-2013 09:22 ; MAW
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**68,1033**;NOV 1, 1997
  1.  ;
  1.  ; Reference to variable DIQUIET supported by DBIA #2098
  1.  ;
  1.  Q
  1.  ;
  1. QUEMU2(LA7UID,LRAA,LRAD,LRAN,LRIDT,LRSS,LRDFN,LRSPEC,LRSAMP,LRSB) ;
  1. QUEUE ;
  1.  ; Called by protocol LA7 LAB RESULTS ACTION
  1.  ; and below (APQ) for AP subscripts
  1.  ; Call with:
  1.  ;  LRAA   - accession area (CH,MI subscript)
  1.  ;  LRAD   - accession date (CH,MI subscript)
  1.  ;  LRAN   - accession number (CH,MI subscript)
  1.  ;  LRIDT  - inverse date/time (collection date/time)
  1.  ;  LRSS   - test subscript defined in LABORATORY TEST file (#60)
  1.  ;  LRDFN  - IEN in LAB DATA file (#63)
  1.  ;  LRSPEC - specimen
  1.  ;  LRSAMP - sample
  1.  ;  LRSB (Optional) - array of Chemistry results
  1.  ;                      ex. glucose LRSB(2)=LR NODE
  1.  ;
  1.  N I,LA76248,LA7V,LA7VCH,LASTYP,LAVERR,X,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  ;N (LA7UID,LRAA,LRAD,LRAN,LRIDT,LRSS,LRDFN,LRSPEC,LRSB)
  1.  ;
  1.  S LA7PAT=$P($G(^LR(LRDFN,0)),U,3)  ;needed to see if inpatient
  1.  I $D(^DPT(LA7PAT,.1)) S LA7INPT=1  ;flag as inpatient
  1.  ; If no accession area then quit - not much we can do.
  1.  I $G(LRAA)="" Q
  1.  ;
  1.  ; If LRSS not defined then set from file #68
  1.  I $G(LRSS)="" N LRSS S LRSS=$P($G(^LRO(68,LRAA,0)),"^",2)
  1.  ;
  1.  ; Not supporting AU and BB at this time (or if LRSS is null).
  1.  I "AUBB"[LRSS Q
  1.  ;
  1.  ; Check if CPRS has called us more than once for this accession.
  1.  ; Results are processed on first call.
  1.  I $D(LRTMPO("LRIFN")),$G(LRNIFN)>1 Q
  1.  I LRSS="MI",$D(LRTMPO("LRIFN")),$G(^TMP("LA7HDR",$J))=(LRAA_"^"_LRAD_"^"_LRAN) K ^TMP("LA7HDR",$J) Q
  1.  ;
  1.  ; Quit if test patient on a production account.
  1.  I $$TESTPAT^VADPT($P($G(^LR(LRDFN,0)),"^",3)),$$PROD^XUPROD(0) Q
  1.  ;
  1.  ; Check for configuration LA7HDR in 62.48 to see if turned on and site wants subscribers to receive HL7 messages for this event.
  1.  ; Task HL7 message building and transmission.
  1.  ; HDR-IMS will be using HL7 messaging, no call to VDEF API.
  1.  S LA76248=$O(^LAHM(62.48,"B","LA7HDR",0))
  1.  I 'LA76248 Q
  1.  I '$P(^LAHM(62.48,LA76248,0),"^",3) Q  ; not active
  1.  ;
  1.  S LA7SITE=$O(^BLRRLMU("B",DUZ(2),0))
  1.  S LA7FAC=$P($G(^DIC(4,DUZ(2),0)),U)
  1.  S LA7VER=$P($G(^BLRRLMU(LA7SITE,0)),U,2)
  1.  S ZTRTN="BUILD^LA7CHDR",ZTDTH=$H,ZTIO="",ZTDESC="Tasked Lab HL7 HDR ORU Build"
  1.  F I="LRAA","LRAD","LRAN","LRIDT","LRSS","LRDFN","LA7SITE","LA7FAC","LA7VER","LRSPEC","LA7UID" S ZTSAVE(I)=""
  1.  I LRSS="CH" D
  1.  . S LA7V=0
  1.  . F  S LA7V=$O(LRSB(LA7V)) Q:'LA7V  D
  1.  . . I $P(LRSB(LA7V),"^")="" Q
  1.  . . S LA7VCH(LA7V)=LRSB(LA7V)
  1.  . . I $D(LRSA(LA7V,2)) S LA7VCH(LA7V,1)="C"
  1.  . S ZTSAVE("LA7VCH*")="",ZTSAVE("LRSPEC")=""
  1.  I LRSS="CH",'$D(LA7VCH) Q
  1.  S ZTSAVE=("LA7MTYP")="ORU"
  1.  D BUILD^LA7CHDR
  1.  ;maw remove below once i have it working
  1.  ;D ^%ZTLOAD
  1.  ;I $G(ZTSK)'>0 Q
  1.  ;
  1.  ; Set flag to handle CPRS calling us multiple times during verifying session for each ordered test.
  1.  ;S ^TMP("LA7HDR",$J)=LRAA_"^"_LRAD_"^"_LRAN
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. APQ(LRDFN,LRSS,LRIDT) ; Anatomic Pathology (CY,EM,SP) subscript entry point from FileMan cross-reference on specific fields.
  1.  ; Called by field #.11 in sub-files #63.02, 63.08, 63.09 - AP does not work through CPRS extended action protocols
  1.  ;
  1.  ; Only send file #2 patients to HDR
  1.  I $P($G(^LR(LRDFN,0)),"^",2)'=2 Q
  1.  ;
  1.  D QUEUE
  1.  Q
  1.  ;
  1.  ;
  1. BUILD ; Tasked entry point to build HL7 message to VA's HDR
  1.  ; Tasked from above.
  1.  ;
  1.  N DIQUIET,FDA,GBL,HL,HLQ,RUID,SITE
  1.  N LA76248,LA76249P,LA7DT,LA7ERR,LA7EVNT,LA7ID,LA7INTYP,LA7LNCVR,LA7LOAD,LA7NOMSG,LA7NVAF,LA7RSITE,LA7X,LA7Y,LRQUIET,LRUID
  1.  ;
  1.  ; Prevent FileMan from issuing any unwanted WRITE(s).
  1.  S (DIQUIET,LRQUIET)=1
  1.  ; Insure DILOCKTM is defined
  1.  D DT^DICRW
  1.  ;
  1.  ; Lock record while building message.
  1.  ;F  L +^LR(LRDFN,LRSS,LRIDT,0):DILOCKTM Q:$T  H 5
  1.  ;
  1.  S (LA7ERR,LA7NVAF)=0,LA7EVNT="LA7 LAB RESULTS AVAILABLE (EVN)"
  1.  ; Create 62.49 entry but don't store message text.
  1.  ;S LA7NOMSG=2
  1.  S LA7NOMSG=0
  1.  ;
  1.  I $G(LA7MTYP)="" S LA7MTYP="ORU"
  1.  ;
  1.  S LA7X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
  1.  S LRUID=$P(LA7X,"^"),RUID=$P(LA7X,"^",5)
  1.  I LRUID="" S LRUID=$$LRUID^LRX(LRAA,LRAD,LRAN)
  1.  ;
  1.  S (LA7RSITE,SITE)="LA7HDR",LA7ID=LA7RSITE_"-O-",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.  S LA7INTYP=+$P(^LAHM(62.48,LA76248,0),"^",9)
  1.  ;
  1.  ; Determine if patient needs to have initial load sent to HDR.
  1.  ; *** need to establish location of HDR flag in 63***
  1.  S LA7LOAD=0
  1.  ;
  1.  ; Create new outgoing entry in 62.49
  1.  S (LA76249,LA76249P)=$$INIT6249^LA7VHLU
  1.  I LA76249<1 D  Q
  1.  . ; Log entry creation error
  1.  ;
  1.  K ^TMP("LA7-QRY",$J)
  1.  ;
  1.  ; Check "CH" test results for ordered tests.
  1.  ; Per Change Control Board decision to perform lab test's result aggregation on VistA -
  1.  ;   - besides test verified during this session include all other test results stored with this specimen.
  1.  I LRSS="CH" D
  1.  . N FDA,FDAIEN,LA7ER,LA7VT,LRSB
  1.  . S LA7Y=1
  1.  . F  S LA7Y=$O(^LR(LRDFN,LRSS,LRIDT,LA7Y)) Q:'LA7Y  D
  1.  . . I '$D(LA7VCH(LA7Y)) S LA7VCH(LA7Y)=^LR(LRDFN,LRSS,LRIDT,LA7Y)
  1.  . . I $P(LA7VCH(LA7Y),"^")="" Q
  1.  . . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LA7Y,$P(LA7VCH(LA7Y),"^",3),LRSPEC)
  1.  . . S LRSB=LA7Y S:$G(LA7VCH(LA7Y,1))="C" $P(LRSB,"^",2)="C"
  1.  . . ;I $D(^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS)) Q  ; Already marked this report to send tried adding this here
  1.  . . D STORE^LA7QRY2
  1.  . . K FDA,FDAIEN,LA7ER
  1.  . . S FDA(2,62.49162,"+2,"_LA76249_",",.01)=LRSB
  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","LA7ER(2)")
  1.  . . D CLEAN^DILF
  1.  . I $G(LA7INPT),'$D(^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS)) D
  1.  . . S ^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS)=""
  1.  ;
  1.  I "CYEMSP"[LRSS D
  1.  . S LRSB=.012,LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"","")
  1.  . D STORE^LA7QRY2
  1.  ;
  1.  I LRSS="MI" D
  1.  . S LRSPEC=$P(^LR(LRDFN,LRSS,LRIDT,0),"^",5)
  1.  . S LA7ND=0
  1.  . F LA7ND=1,5,8,11,16 I $D(^LR(LRDFN,LRSS,LRIDT,LA7ND)) D
  1.  . . I $P(^LR(LRDFN,LRSS,LRIDT,LA7ND),"^",2)="" Q  ; If no status -  skip
  1.  . . I $D(^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS)) Q  ; Already marked this report to send
  1.  . . S LRSB=$S(LA7ND=1:11,LA7ND=5:14,LA7ND=8:18,LA7ND=11:22,LA7ND=16:33,1:11)
  1.  . . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"",LRSPEC)
  1.  . . D STORE^LA7QRY2
  1.  ;
  1.  S GBL="^TMP(""HLS"","_$J_")"
  1.  D STARTMSG^LA7CHLU(LA7EVNT,.LA76249,LA7NOMSG)
  1.  I $G(HL) S LA7ERR=$TR(HL,"^","-")
  1.  S (HLQ,HL("Q"))=""
  1.  D CHKACC^LA7VMSG
  1.  I 'LA7ERR D
  1.  . I LA7LOAD D
  1.  . . N LA7EDT,LA7SC,LA7SDT,LA7SPEC,LRIDT,LRSS,LRUID
  1.  . . S (LA7SC,LA7SPEC)="*",LA7SDT=$$FMADD^XLFDT(DT,-730,0,0,0),LA7EDT=DT
  1.  . . D BCD^LA7QRY2
  1.  . D BUILDMSG^LA7CQRY1
  1.  . D SENDMSG^LA7VMSG1
  1.  S LA7ID=LA7RSITE_"-O-"_LRUID
  1.  D UPDT6249^LA7VORM1
  1.  ; File additional data
  1.  S FDA(1,62.49,LA76249_",",151)=LRUID
  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.  D FILE^DIE("","FDA(1)","LA7ERR(1)")
  1.  D CLEAN^DILF
  1.  ;
  1.  ; Release locks on entries.
  1.  L -^LAHM(62.49,LA76249)
  1.  L -^LR(LRDFN,LRSS,LRIDT)
  1.  ;
  1.  ; Cleanup
  1.  K LA7ND,LRUID,LRNLT,LRIDT,LRSS,LRDFN,LA7VCH,LA7MTYP
  1.  K LA7101,LA7953,LA7CODE,LA7NTESN,LA7OP,LA7PIDSN,LA7PRI,LA7SFT,LA7SITE,LA7VER,LA7FAC,LA7CLDT
  1.  K PID,NK1,SPM,TQ1,NTE
  1.  K LA7PAT,LA7INPT,LA7REJ,LA7ORCSN,LA7ADDON,LA7ADDPN,LA7PARNT,LA7STOR,LA7OBX,LA7OBR
  1.  D EXIT^LA7HDR1
  1.  Q
  1.  ;
  1.  ;
  1. MSH(FS,ECH,SITE) ;return the msh segment
  1.  N I,J,MSH,CS,RS,MSHA,MSHAA
  1.  S MSHA=$G(^BLRRLMU(SITE,"MSH"))
  1.  S MSHAA=$G(^BLRRLMU(SITE,"MSHA"))
  1.  S CS=$E(ECH,1,1)
  1.  S RS=$E(ECH,2,2)
  1.  F I=1:1:25 S MSH(I)=""
  1.  S MSH="MSH"
  1.  S MSH(1)=FS
  1.  S MSH(2)=ECH
  1.  S MSH(3)=$P(MSHA,U)_CS_$P(MSHA,U,2)_CS_$P(MSHA,U,3)
  1.  S MSH(4)=$P(MSHA,U,4)_CS_$P(MSHA,U,5)_CS_$P(MSHA,U,6)
  1.  S MSH(5)=$P(MSHA,U,7)_CS_$P(MSHA,U,8)_CS_$P(MSHA,U,9)
  1.  S MSH(6)=$P(MSHA,U,10)_CS_$P(MSHA,U,11)_CS_$P(MSHA,U,12)
  1.  S MSH(7)=$$FMTHL7^XLFDT($$NOW^XLFDT)
  1.  S MSH(9)="ORU"_CS_"R01"_CS_"ORU_R01"
  1.  S MSH(10)="RPMS-HL-"_$R(100000)
  1.  S MSH(11)="T"
  1.  S MSH(12)=$P($G(^BLRRLMU(SITE,0)),U,2)
  1.  S MSH(15)="NE"
  1.  S MSH(16)="NE"
  1.  I $G(LA7INPT) D
  1.  . S MSH(15)="AL"
  1.  . S MSH(16)="NE"
  1.  S MSH(21)=$P(MSHA,U,13)_CS_$P(MSHA,U,14)_CS_$P(MSHAA,U)_CS_$P(MSHAA,U,2)
  1.  ;lets make this dynamic below as it is for LRI inpatient
  1.  I $G(LA7INPT) S MSH(21)="LRI_Common_Component^Profile Component^2.16.840.1.113883.9.16^ISO~LRI_NG_Component^Profile Component^2.16.840.1.113883.9.13^ISO~LRI_RU_Component^Profile Component^2.16.840.1.113883.9.14^ISO"
  1.  F J=2:1:25 S $P(MSH,FS,J)=MSH(J)
  1.  Q MSH
  1.  ;
  1. RTR(LA7SS) ;
  1.  ; Call with LA7SS = list of subscripts that HDR wants separated by ";"
  1.  ;                   (LA7SS="CH;MI;EM")
  1.  ;
  1.  ; Setup link and subscriber array for HL7 HDR message generation
  1.  ; Determine if HDR wants to receive lab results for this subscript
  1.  ; Called by subscriber router protocol LA7 LAB RESULTS TO HDR (SUB)
  1.  ; Check outgoing message and find OBR segment to determine Laboratory
  1.  ;  subscript this result is associated with and if it's contained in
  1.  ;  the LA7SS subscript list.
  1.  ; 
  1.  N LA7I,LA7SEG,LA7VI,LA7VJ,LA7X,LRSS,LRX
  1.  ; 
  1.  S LRSS=""
  1.  F LA7VI=1:1 X HLNEXT Q:HLQUIT'>0  D  Q:LRSS'=""
  1.  . I $E(HLNODE,1,3)'="OBR" Q
  1.  . S LA7SEG(0)=HLNODE
  1.  . S LA7VJ=0
  1.  . F  S LA7VJ=$O(HLNODE(LA7VJ)) Q:'LA7VJ  S LA7SEG(LA7VJ)=HLNODE(LA7VJ)
  1.  . S LRX=$$P^LA7VHLU(.LA7SEG,21,HL("FS")),LRX=$$UNESC^LA7VHLU3(LRX,HL("FS")_HL("ECH"))
  1.  . S LRSS=$P(LRX,"^",2)
  1.  ;
  1.  F LA7I=1:1 S LA7X=$P(LA7SS,";",LA7I) Q:LA7X=""  D  Q:LA7X=""
  1.  . I LA7X=LRSS S HLL("LINKS",1)="LA7 LAB RESULTS TO HDR (SUB)^VDEFVIE4",LA7X=""
  1.  Q
  1.  ;
  1.  ;
  1. HDRLOAD(LA7SDT,LA7EDT,LA7LIMIT,LA7EVENT) ; Load patient's historical lab results to HDR (Health Data Repository).
  1.  ; Call with LA7SDT = start date of data extraction in FileMan format
  1.  ;           LA7EDT = end date of data extraction in FileMan format
  1.  ;         LA7LIMIT = # of messages to create this session (default =1000)
  1.  ;         LA7EVENT = name of HL7 event protocol to transmit messages
  1.  ;
  1.  D HDRLOAD^LA7HDR1
  1.  Q
  1.  ;
  1.  ;
  1. RECOVER ; Recover failed transmissions or message building
  1.  ; Called by option Recover/Transmit Lab HDR Result Messages [LA7 HDR RECOVER]
  1.  ;
  1.  D RECOVER^LA7HDR1
  1.  Q