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

DVBAMVI2.m

Go to the documentation of this file. 
  1. DVBAMVI2 ;ALB/RPM - CAPRI MVI GET CORRESPONDING IDS ;8/6/2012
  1.  ;;2.7;AMIE;**181,223**;Apr 10, 1995;Build 15
  1.  ; SAC EXEMPTION 20201020-01 : Xindex error, use of HWSC Object
  1.  ;
  1.  ; Get Corresponding Ids is a function of the MVI service,
  1.  ; used to retrieve all known MVI Identifiers as they relate
  1.  ; to a source identifier. The transaction grouping for this
  1.  ; interaction is a 1309 Request and 1310 Response.
  1.  ;
  1.  Q  ;NO DIRECT ENTRY
  1.  ;
  1. GETIDS(DVBRSLT,DVBIID) ;
  1.  ;This procedure supports the DVBA MVI GET CORRESPONDING IDS remote
  1.  ;procedure. An MVI patient identifier string is passed to the procedure.
  1.  ;The procedure generates a 1309 Get Corresponding IDs HL7v3 request
  1.  ;message and transmits it to the MVI.  A list of station numbers is
  1.  ;returned in a 1310 HL7v3 message to represent the treating facility list.
  1.  ;The INSTITUTION (#4) file IEN, station name, and station number is
  1.  ;returned for each treating facility. 
  1.  ;
  1.  ;  Input:
  1.  ;    DVBRSLT - RPC results parameter defined as an ARRAY
  1.  ;    DVBIID = Patient identifier delimited using "^"
  1.  ;      Piece 1: Id
  1.  ;      Piece 2: IdType
  1.  ;      Piece 3: Assigning location
  1.  ;      Piece 4: Assigning issuer
  1.  ;
  1.  ;      Example: 1008523099V750710^NI^200M^USVHA
  1.  ;
  1.  ;  Output:
  1.  ;    DVBRSLT - array of lines each containing station IEN, name ,
  1.  ;              and station number delimited by a caret ("^").  The
  1.  ;              first array node contains the total number of stations
  1.  ;              returned and the query response.
  1.  ;
  1.  ;             Format: instutionIEN^stationName^stationNumber
  1.  ;
  1.  ;       Example:  DVBOUT(0)=2^OK
  1.  ;                 DVBOUT(1)="516^BAY PINES VA HCS^516"
  1.  ;                 DVBOUT(2)="523^BOSTON HCS VAMC^523"
  1.  ;
  1.  N DVBPRS  ;parsed results array
  1.  N DVBXML  ;1309 HL7v3 XML request
  1.  N DVBXMLR  ;1310 HL7v3 XML results
  1.  ;
  1.  ;create the 1309 request message
  1.  S DVBXML=$$CRE81309(DVBIID)
  1.  ;
  1.  ;transmit the message to the MVI
  1.  D XMIT(DVBXML,.DVBXMLR)
  1.  ;
  1.  ;parse the returned 1310 result message
  1.  I $D(DVBXMLR) D
  1.  . D PARSE(.DVBXMLR,.DVBPRS)
  1.  . ;
  1.  . ;format the output array
  1.  . D OUTPUT(.DVBPRS,.DVBRSLT)
  1.  E  D
  1.  . S DVBRSLT(0)=0_U_"Communication error occurred"
  1.  Q
  1.  ;
  1. CRE81309(DVBIID) ; create 1309 request xml document
  1.  ; This function creates the HL7v3 1309 Get Corresponding IDs
  1.  ; Request xml document.
  1.  ;
  1.  ; DVBIID = Patient identifier delimited using "^"
  1.  ;   Piece 1: Id
  1.  ;   Piece 2: IdType
  1.  ;   Piece 3: Assigning location
  1.  ;   Piece 4: Assigning issuer
  1.  ;
  1.  ;   ex.  1008523099V750710^NI^200M^USVHA
  1.  ;
  1.  ;   Returns formatted XML for the search
  1.  ;
  1.  ; $$PARAM^HLCS2 - #3552 (need)
  1.  ;
  1.  N DVBSKEY   ;site key
  1.  N DVBPCODE  ;HL7 processing code
  1.  N MPIXML    ;function result
  1.  ;
  1.  S DVBPCODE=$P($$PARAM^HLCS2,"^",3)
  1.  S DVBSKEY="200CAPR"
  1.  ;
  1.  ;Header
  1.  S MPIXML="<PRPA_IN201309UV02 xmlns=""urn:hl7-org:v3"" "
  1.  S MPIXML=MPIXML_"xmlns:ps=""http://vaww.oed.oit.domain.ext"" "
  1.  S MPIXML=MPIXML_"xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"
  1.  S MPIXML=MPIXML_""" xsi:schemaLocation=""urn:hl7-org:v3 ../../schema/"
  1.  S MPIXML=MPIXML_"HL7V3/NE2008/multicacheschemas/PRPA_IN201309UV02.xsd"
  1.  S MPIXML=MPIXML_""" ITSVersion=""XML_1.0"">"
  1.  S MPIXML=MPIXML_"<id root=""2.16.840.1.113883.4.349"" "
  1.  S MPIXML=MPIXML_"extension=""MCID-12345""/>"
  1.  S MPIXML=MPIXML_"<creationTime value="""_$$FMTHL7^XLFDT($$NOW^XLFDT())_"""/>"
  1.  S MPIXML=MPIXML_"<interactionId root=""2.16.840.1.113883.1.6"" "
  1.  S MPIXML=MPIXML_"extension=""PRPA_IN201309UV02""/>"
  1.  S MPIXML=MPIXML_"<processingCode code="""_DVBPCODE_"""/>"
  1.  S MPIXML=MPIXML_"<processingModeCode code=""T""/>"
  1.  S MPIXML=MPIXML_"<acceptAckCode code=""AL""/>"
  1.  ;
  1.  ;<receiver> start
  1.  S MPIXML=MPIXML_"<receiver typeCode=""RCV"">"
  1.  S MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
  1.  S MPIXML=MPIXML_"<id root=""2.16.840.1.113883.4.349""/>"
  1.  S MPIXML=MPIXML_"<telecom value=""http://servicelocation/PDQuery""/>"
  1.  S MPIXML=MPIXML_"</device></receiver>"
  1.  ;
  1.  ;<sender> start
  1.  S MPIXML=MPIXML_"<sender typeCode=""SND"">"
  1.  S MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
  1.  S MPIXML=MPIXML_"<id extension="""_DVBSKEY_""" root=""2.16.840.1.113883.4.349""/>"
  1.  S MPIXML=MPIXML_"</device></sender>"
  1.  ;
  1.  ;<controlActProcess> start
  1.  S MPIXML=MPIXML_"<controlActProcess "
  1.  S MPIXML=MPIXML_"classCode=""CACT"" moodCode=""EVN"">"
  1.  S MPIXML=MPIXML_"<code code=""PRPA_TE201309UV02"" "
  1.  S MPIXML=MPIXML_"codeSystem=""2.16.840.1.113883.1.6""/>"
  1.  S MPIXML=MPIXML_"<queryByParameter><queryId extension="""_$J_""""
  1.  S MPIXML=MPIXML_" root=""2.16.840.1.113883.4.349""/>"
  1.  S MPIXML=MPIXML_"<statusCode code=""new""/>"
  1.  S MPIXML=MPIXML_"<responsePriorityCode code=""I"" />"
  1.  S MPIXML=MPIXML_"<parameterList>"
  1.  S MPIXML=MPIXML_"<patientIdentifier>"
  1.  S MPIXML=MPIXML_"<value root=""2.16.840.1.113883.4.349"" extension="""_DVBIID_"""/>"
  1.  S MPIXML=MPIXML_"<semanticsText>Patient.Id</semanticsText>"
  1.  S MPIXML=MPIXML_"</patientIdentifier>"
  1.  S MPIXML=MPIXML_"</parameterList>"
  1.  S MPIXML=MPIXML_"</queryByParameter></controlActProcess>"
  1.  S MPIXML=MPIXML_"</PRPA_IN201309UV02>"
  1.  Q MPIXML
  1.  ;
  1. XMIT(DVBXML,DVBXMLR) ;
  1.  ;
  1.  ; $$GETPROXY^XOBWLIB - #5421
  1.  ;
  1.  N $ETRAP,$ESTACK,SVC
  1.  ;
  1.  ; set error trap
  1.  S $ETRAP="DO ERROR^DVBAHWSC"
  1.  ;
  1.  ; make the call
  1.  S SVC=$$GETPROXY^XOBWLIB("DVB_PSIM_EXECUTE","DVB_MVI_SERVER")
  1.  S DVBXMLR=SVC.execute(DVBXML)
  1.  ;
  1.  Q
  1.  ;
  1. PARSE(DVBXML,DVBOUT) ;
  1.  ;
  1.  ; EN^MXMLPRSE - #4149
  1.  ;
  1.  K ^TMP($J,"DVBAMVI2")
  1.  N DVBCB     ;parser callback array
  1.  N DVBCNT    ;record counter
  1.  S DVBCNT=0
  1.  S DVBCB("STARTELEMENT")="SE^DVBAMVI2"
  1.  S ^TMP($J,"DVBAMVI2",1)=DVBXML
  1.  D EN^MXMLPRSE($NA(^TMP($J,"DVBAMVI2")),.DVBCB)
  1.  K ^TMP($J,"DVBAMVI2")
  1.  Q
  1.  ;
  1. SE(DVBNM,DVBATTR) ; - used for the parser to call back with STARTELEMENT
  1.  ;
  1.  ; prevent any undefined errors
  1.  S DVBNM=$G(DVBNM)
  1.  S DVBATTR("extension")=$G(DVBATTR("extension"))
  1.  ;
  1.  ;
  1.  I DVBNM="id",$E(DVBATTR("extension"),1,4)="MCID" Q
  1.  I DVBNM="id",DVBATTR("extension")?3N.NA Q
  1.  I DVBNM="id",DVBATTR("extension")="" Q
  1.  I DVBNM="id",DVBATTR("extension")["NI^200M^USVHA^P" Q
  1.  ;
  1.  ;response code
  1.  I DVBNM="queryResponseCode",$G(DVBOUT(0))="" D  Q
  1.  . S DVBOUT(0)=$S(DVBATTR("code")="NF":"No match found for "_DVBIID,1:DVBATTR("code"))
  1.  ;
  1.  ;set station numbers
  1.  ;pattern match DFN_"^PI^"_stationNumber_"^USVHA^"_alpha
  1.  I DVBNM="id",DVBATTR("extension")?1.N1"^PI^"2N.NA1"^USVHA^".A D  Q
  1.  . S DVBOUT($P(DVBATTR("extension"),U,3))=""
  1.  Q
  1.  ;
  1. OUTPUT(DVBIN,DVBOUT) ;
  1.  ;This procedure formats the individual record lines and builds
  1.  ;the results array output for the remote procedure.
  1.  ;
  1.  ;  Input:
  1.  ;    DVBIN - array of station numbers
  1.  ;
  1.  ;  Output:
  1.  ;    DVBOUT - array of lines each containing station IEN, name ,
  1.  ;             and station number delimited by a caret ("^"). The
  1.  ;             first array node contains the returned station count
  1.  ;             and the query response.
  1.  ;                  
  1.  ;       Example:  DVBOUT(0)=2^OK
  1.  ;                 DVBOUT(1)="516^BAY PINES VA HCS^516"
  1.  ;                 DVBOUT(2)="523^BOSTON HCS VAMC^523"
  1.  ;
  1.  N DVBSTA  ;station number
  1.  N DVBCNT  ;results counter
  1.  N DVBIEN  ;INSTITUTION (#4) file IEN
  1.  S DVBSTA=""
  1.  S DVBCNT=0
  1.  F  S DVBSTA=$O(DVBIN(DVBSTA)) Q:(DVBSTA="")  D
  1.  . S DVBIEN=+$$IEN^XUAF4(DVBSTA)
  1.  . I DVBIEN D
  1.  . . S DVBCNT=DVBCNT+1
  1.  . . S DVBOUT(DVBCNT)=DVBIEN_U_$$NS^XUAF4(DVBIEN)
  1.  S DVBOUT(0)=DVBCNT_U_$G(DVBIN(0))
  1.  Q
  1. GETACC(DVBOUT,DVBICN) ;get Active Cerner Correlations from mpi via hl7 direct rpc
  1.  ;
  1.  ; DVBOUT - return 0 (no) or 1 (yes) cerner active correlations or -1 (error)
  1.  ; DVBICN - patient identifier (icn)
  1.  ;
  1.  ; DIRECT^XWB2HL7 supported by subscription to ICR #3144
  1.  ;
  1.  Q:$G(DVBICN)=""
  1.  N DVBARRAY,DVBERROR
  1.  D DIRECT^XWB2HL7(.DVBARRAY,"200M","MPI GETCORRESPONDINGIDS","",DVBICN)
  1.  ;check for errors when connecting to mpi
  1.  S DVBERROR="An error has occurred that prevents CAPRI from determining if Cerner treatment records exist. Please try again. If this error persists after several attempts, please open a trouble ticket requesting IT support."
  1.  I $P($G(DVBARRAY(0)),"^")=""!($P($G(DVBARRAY(1)),"^")=-1) S DVBOUT="-1^"_DVBERROR_"^"_$G(DVBARRAY(1)) Q
  1.  D CHKACC(.DVBARRAY,.DVBOUT) ;pass by reference to set dvbout
  1.  Q
  1.  ;
  1. CHKACC(DVBARRAY,DVBOUT) ;check for Active Correlations with '200CRNR'
  1.  ;
  1.  ; DVBARRAY - array of patient's active correlations from mpi
  1.  ; DVBOUT -  return 0 (no) or 1 (yes) cerner active correlation
  1.  ;
  1.  N DVBRECN,DVBCRN,DVBERROR
  1.  S (DVBOUT,DVBCRN)=0
  1.  I $D(DVBARRAY) S DVBRECN="" F  S DVBRECN=$O(DVBARRAY(DVBRECN)) Q:DVBRECN=""  D  Q:DVBOUT=1
  1.   .I $P(DVBARRAY(DVBRECN),"^",2)="200CRNR"  S DVBCRN=1 D  ; check if active correlation contains '200CRNR'
  1.   ..; check date last treated (piece 3) not null, id type (piece 4) is pi, and status of icn or correlation (piece 6) is active
  1.   ..I $P(DVBARRAY(DVBRECN),"^",3)'="",$P(DVBARRAY(DVBRECN),"^",4)="PI" D
  1.   ...I (($P(DVBARRAY(DVBRECN),"^",6)="A")!($P(DVBARRAY(DVBRECN),"^",6)="")) S DVBOUT=1
  1.  I DVBCRN=0 D  ; if no active correlations contain '200CRNR'
  1.   .S DVBERROR="An error has occurred that prevents CAPRI from determining if Cerner treatment records exist. Please try again. If this error persists after several attempts, please open a trouble ticket requesting IT support."
  1.   .S DVBOUT="-1^"_DVBERROR_"^-1^'200CRNR' not found at MPI"
  1.  Q