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