- 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 Feb 18, 2025@23:26:24 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