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

LA7POC.m

Go to the documentation of this file. 
  1. LA7POC ;VA/DALOI/JMC - Lab HL7 Point of Care; Jan 12, 2004
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**1031**;NOV 01, 1997
  1.  ;
  1.  ;;VA LA Patche(s): 67
  1.  ;
  1.  ;
  1.  ; Reference to HLL("SET FOR APP ACK") supported by DBIA #TBD
  1.  Q
  1.  ;
  1. RTRA ; Setup links and subscriber array for HL7 ADT message generation
  1.  ; for those LA7POC* entries in file #62.48 which indicate they want to
  1.  ; subscribe to ADT messages. Interface types POCA in file #62.48
  1.  ; will be subscribers to VistA HL7 ADT messages.
  1.  ;
  1.  ; Called by subscriber protocol LA7POC ADT RTR which functions as a
  1.  ; router.
  1.  ;
  1.  N LA76248,LA7Y
  1.  ;
  1.  ; Check entries with root 'LA7POC" as name and interface type POCA (21)
  1.  ; to subscribe to ADT message feed from VistA.
  1.  S LA76248=0
  1.  F  S LA76248=$O(^LAHM(62.48,LA76248)) Q:'LA76248  D
  1.  . S LA76248(0)=$G(^LAHM(62.48,LA76248,0)),LA7Y=$P(LA76248(0),"^")
  1.  . I $E(LA7Y,1,6)'="LA7POC" Q
  1.  . I $P(LA76248(0),"^",3)'=1 Q  ; Inactive status
  1.  . I $P(LA76248(0),"^",9)'=21 Q
  1.  . S HLL("LINKS",LA76248)=LA7Y_" ADT SUBS^"_LA7Y_"A"
  1.  Q
  1.  ;
  1.  ;
  1. ACK(LA7) ; Returns the application acknowledgement to the sending POC
  1.  ; application. Indicates any error encountered in processing the POC
  1.  ; results. Setup link for HL7 ACK message generation for LA7POC* entries
  1.  ; in file #62.48 when POC ORU message has been processed in VistA.
  1.  ;
  1.  ; Called by routine LA7VPOC
  1.  ;
  1.  ; Call with LA7 array passed by reference
  1.  ;      LA7(62.48)=ien of related configuration in file #62.48  
  1.  ;      LA7(62.49)=ien of message in file #62.49 being acknowledged
  1.  ;      LA7("ACK")=acknowledgment status (AA, AE, AR)
  1.  ;      LA7("MSG")=text of error message to be returned
  1.  ;
  1.  N HL,HLMTIENS,LA6249,LA76248,LA7X,LA7Y
  1.  ;
  1.  ; Check for entry in 62.48
  1.  S LA76248=+$G(LA7(62.48))
  1.  I '$G(LA76248)!('$D(^LAHM(62.48,LA76248,0))) Q
  1.  S LA76248(0)=$G(^LAHM(62.48,LA7(62.48),0)),LA7X=$P(LA76248(0),"^")
  1.  ;
  1.  ; Check for entry in 62.49
  1.  S LA6249=+$G(LA7(62.49))
  1.  I '$G(LA6249)!('$D(^LAHM(62.49,LA6249,0))) Q
  1.  F I=0,700 S LA6249(I)=$G(^LAHM(62.49,LA6249,I))
  1.  ;
  1.  ; Call reprocess message to build and send ACK and clear purge flag
  1.  S LA7Y=$$REPROC^HLUTIL($P(LA6249(700),";",2),"D BLDACK^LA7POC")
  1.  I LA7Y=0 S HLMTIENS=$P(LA6249(700),";",2),LA7X=$$TOPURG^HLUTIL()
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. BLDACK ; Create/initialize HL ACK message
  1.  ;
  1.  N GBL,HLL,HLP,I,X
  1.  N LA76249,LA7AERR,LA7DATA,LA7ECH,LA7FS,LA7ID,LA7MID,LA7MSA,LA7MSH,LA7X,LA7Y
  1.  ;
  1.  ; No application acknowledgement
  1.  I HL("APAT")="NE" Q
  1.  ;
  1.  ; Other system only wants ACK on successful completion condition and we found an error.
  1.  I LA7("ACK")'="AA",HL("APAT")="SU" Q
  1.  ;
  1.  ; Other system only wants ACK on error/reject condition
  1.  I LA7("ACK")="AA",HL("APAT")="ER" Q
  1.  ;
  1.  S GBL="^TMP(""HLA"","_$J_")"
  1.  K @GBL
  1.  S LA76249=$$INIT6249^LA7VHLU
  1.  D RSPINIT^HLFNC2(HL("EIDS"),.HL)
  1.  S LA7FS=HL("RFS"),LA7ECH=HL("RECH")
  1.  ;
  1.  ; Build pseudo MSH for file #62.49 entry
  1.  S LA7MSH(0)="MSH",LA7MSH(1)=LA7ECH,LA7MSH(2)=HL("RAN"),LA7MSH(3)=HL("RAF"),LA7MSH(4)=HL("SAN"),LA7MSH(5)=HL("SAF")
  1.  S LA7MSH(9)=HL("RMTN")_$E(LA7ECH,1)_HL("RETN"),LA7MSH(11)=HL("PID"),LA7MSH(12)=HL("VER")
  1.  S LA7MSH(15)="AL",LA7MSH(16)="NE"
  1.  D BUILDSEG^LA7VHLU(.LA7MSH,.LA7DATA,LA7FS)
  1.  D FILE6249^LA7VHLU(LA76249,.LA7DATA)
  1.  ;
  1.  ; Build and file MSA segment
  1.  K LA7DATA
  1.  S LA7MSA(0)="MSA",LA7MSA(1)=LA7("ACK"),LA7MSA(2)=HL("MID")
  1.  I $G(LA7("MSG"))'="" D
  1.  . S LA7MSA(3)=$$CHKDATA^LA7VHLU3($P(LA7("MSG"),"^"),LA7FS_LA7ECH)
  1.  . I $P(LA7("MSG"),"^",2)="" Q
  1.  . S $P(LA7MSA(3),$E(LA7ECH),2)=$$CHKDATA^LA7VHLU3($P(LA7("MSG"),"^",2),LA7FS_LA7ECH)
  1.  S LA7ID=$P(LA76248(0),"^",1)_"-O-ACK-"_LA7MSA(2)
  1.  D BUILDSEG^LA7VHLU(.LA7MSA,.LA7DATA,LA7FS)
  1.  D FILESEG^LA7VHLU(GBL,.LA7DATA)
  1.  D FILE6249^LA7VHLU(LA76249,.LA7DATA)
  1.  ;
  1.  ; Send the HL7 message.
  1.  S HLL("SET FOR APP ACK")=1
  1.  S HLL("LINKS",1)=HL("EIDS")_"^"_$P(LA76248(0),"^")
  1.  S HLP("NAMESPACE")="LA"
  1.  D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.LA7MID,"",.HLP)
  1.  ;
  1.  S HL("MTN")=HL("RMTN"),HL("SAN")=HL("RAN"),HL("SAF")=HL("RAF"),HL("APAT")=""
  1.  D UPDT6249^LA7VORM1
  1.  L -^LAHM(62.49,LA76249)
  1.  Q