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

MAGDHLE.m

Go to the documentation of this file.
  1. MAGDHLE ;WOIFO/SRR/PMK - PACS INTERFACE PID TRIGGERS ; Dec 05, 2019@09:10:48
  1. ;;3.0;IMAGING;**54,49,183,231**;Mar 19, 2002;Build 9;Apr 07, 2011
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. ; Supported IA #10063 reference ^%ZTLOAD subroutine call
  1. ; Supported IA #2602 Reading AUDIT file (#1.1) ^DIA(2,...)
  1. ; Supported IA #2541 reference $$KSP^XUPARAM function call
  1. ; Supported IA #4440 reference $$PROD^XUPROD function call
  1. ;
  1. Q
  1. ;
  1. SENDA08(DFN) ; External API entry point from Radiology Package - P183 PMK 3/16/17
  1. N MAGSENDA08 S MAGSENDA08=1 ; flag to indicate API call
  1. ; drop through to ADTA08
  1. ;
  1. ADTA08 ; Patient Update event from VAFC ADT-A08 SERVER event driver - P183 PMK 3/16/17
  1. ; Upon entry, DFN will be set to the patient
  1. ; The DG* variables are not defined by the VAFC package
  1. N DGPMDA,DGNOW,DGPMA,DGPMT,MAGKTYP,MAGDPTCL
  1. N HLECH,HLFS,HLINSTN,HLPARAM,HLPID,HLRFREQ,HLSFREQ,HLSAN,HLTYPE,HLQ,HLXM
  1. N HL771RF,HL771SF,HLCS,HLDOM,HLN,HLPARM,HLREC,SEGIX,SUB4,VA,VADM,VACNTRY
  1. N SSNCHANGES ;--- array of old & new SSNs, indexed chronologically
  1. ;
  1. S (DGPMDA,DGNOW,DGPMA,MAGDPTCL)="" ; unused
  1. I $$SSNCHECK(.SSNCHANGES) D ; generate ADT A47
  1. . S DGPMT=47 ; set DGPMT variable for use in MAGDHLI
  1. . S MAGKTYP=47 ; set MAGKTYP variable for EVN+1 below
  1. . Q
  1. E D ; generate ADT A08
  1. . S DGPMT=8 ; set DGPMT variable for use in MAGDHLI
  1. . S MAGKTYP=8 ; set MAGKTYP variable for EVN+1 below
  1. . Q
  1. G TSK ; generate the HL7 ADT A08 or ADT A47 message
  1. ;
  1. SSNCHECK(SSNCHANGES) ; Check for SSN change, return values
  1. ; Return 1 if there was an SSN change and 0 otherwise
  1. ; If there was an SSN change, do the following:
  1. ; save the old value in SSNCHANGES(DATEIME,"OLD")
  1. ; save the new value in SSNCHANGES(DATEIME,"NEW")
  1. ; set NEWSSN(DATEIME) to the new value
  1. N DATETIME ; date and time of the SSN change
  1. N DIAIEN ; ien of the record in the AUDIT file (#1.1)
  1. N FIELDNUMBER ; SSN is field .09 in the PATIENT file (#2)
  1. N OLDSSN ; previous value of SSN, can't be null
  1. N X
  1. S DIAIEN=""
  1. F S DIAIEN=$O(^DIA(2,"B",DFN,DIAIEN)) Q:DIAIEN="" D
  1. . S X=$G(^DIA(2,DIAIEN,0))
  1. . S DATETIME=$P(X,"^",2),FIELDNUMBER=$P(X,"^",3)
  1. . I FIELDNUMBER'=.09 Q ; not an SSN change record
  1. . S OLDSSN=$G(^DIA(2,DIAIEN,2))
  1. . I OLDSSN="" Q ; no previous SSN value, don't send A47
  1. . S SSNCHANGES(DATETIME,"OLD")=OLDSSN
  1. . S SSNCHANGES(DATETIME,"NEW")=$G(^DIA(2,DIAIEN,3))
  1. . Q
  1. I '$G(MAGSENDA08) D ; invocation by HL7 event driver
  1. . ; invocation by VAFC ADT-A08 SERVER event driver
  1. . ; keep the most recent change if it was done today
  1. . N A
  1. . S DATETIME=$O(SSNCHANGES(""),-1)
  1. . I DATETIME M A(DATETIME)=SSNCHANGES(DATETIME) ; save last change
  1. . K SSNCHANGES ; kill the SSN change history
  1. . I DT>DATETIME K A ; if last change was before today, kill it too
  1. . M SSNCHANGES=A ; save last change, if any
  1. . Q
  1. Q $D(SSNCHANGES)
  1. ;
  1. ;
  1. ADT ;ADT EVENTS ;From EVENT driver
  1. ;Protocol = MAGD DHCP-PACS ADT EVENTS
  1. ;IN ;DFN
  1. ;DGPMDA = IFN Primary Movement
  1. ;DGPMA = 0th node Primary Movement AFTER movement
  1. ;DGPMP = 0th node PRIOR to movement
  1. ;^UTILITY("DGPM",$J,TRANSACTION (1,2,3,6),MOVEMENT (IFN),"P"/"A")
  1. ;
  1. N I K MAGKTYP F I=1,2,3 I $D(^UTILITY("DGPM",$J,I,DGPMDA)) S MAGKTYP=I
  1. Q:'$D(MAGKTYP) I MAGKTYP=2,$P(^UTILITY("DGPM",$J,2,DGPMDA,"A"),U,6)=$P(^("P"),U,6) G EX
  1. ;
  1. ;
  1. TSK ;CREATE TASK to make HL7 messages
  1. S ZTSAVE("MAGKTYP")="",ZTSAVE("MAGDPTCL")="",ZTSAVE("SSNCHANGES(")="" ; P183 PMK 3/9/17
  1. S ZTSAVE("DGPMDA")="",ZTSAVE("DGNOW")="",ZTSAVE("DGPMA")=""
  1. S ZTSAVE("DFN")="",ZTSAVE("DGPMT")="",ZTDTH=$H,ZTIO=""
  1. S ZTRTN="HL7^MAGDHLE",ZTDESC=$S(MAGKTYP=8:"PID",1:"ADT")_" HL7 PACS MESSAGE"
  1. I $$PROD^XUPROD D ; production - P183 PMK 3/30/2017
  1. . D ^%ZTLOAD
  1. . Q
  1. E D ; development
  1. . N HLTC,HLDT,HLDT1,HLMID,HLRESLT1,HLENROU,HLEXROU ; GENERATE^HLMA variables
  1. . W !?5,"*** HL7 TASK FOR PACS ***"
  1. . D HL7 ; enable debugging in development
  1. . Q
  1. G EX
  1. ;
  1. HL7 ;Create HL7 message
  1. N IEN,KSITEPAR
  1. ; P231 PMK - Replaced hardcoded "1" site parameter with IEN for kernel institution site parameter.
  1. S KSITEPAR=$$KSP^XUPARAM("INST")
  1. S IEN=$O(^MAG(2006.1,"B",KSITEPAR,""))
  1. I $P($G(^MAG(2006.1,IEN,"IHE")),"^",1)="Y" D ADT^MAGDHLI
  1. Q
  1. ;
  1. EX ;EXIT
  1. K ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE
  1. K MAGKPID,MAGKTYP
  1. Q
  1. ;
  1. ; Vestigial code, kept around since there still cross references somewhere
  1. SET ;Set Logic from MUMPS x-ref on fields .01,.03,.09 of ^DD(2 (^DPT)
  1. Q
  1. ;
  1. KIL ;Kill logic "AKn" cross references
  1. Q