RAHLRS ;HIRMFO/CRT/PDW - Resend HL7 messages for selected cases ; Jan 13, 2021@12:17:40
;;5.0;Radiology/Nuclear Medicine;**25,54,60,71,82,95,137,156,178**;Mar 16, 1998;Build 2
;
; Utility to RESEND HL7 messages
;
;Integration Agreements
;----------------------
;SENDA08^MAGDHLE (6761 - Private)
;^MAG(2006.1, IHE flag (6860 - Private)
;$$PATCH^XPDUTL (10141 - Supported)
;$$KSP^XUPARAM("INST") (2541 - Supported)
;
;;02/14/2006 BAY/KAM RA*5*71 Add ability to update exam data to V/R
N RACNI,RADFN,RADTI,RARPT,X
;
D SETVARS Q:$G(RAIMGTY)=""
;
F S X=$$RACNLU(.RADFN,.RADTI,.RACNI) Q:+X'>0 D Q:QUIT<0
.D RESEND(RADFN,RADTI,RACNI,.QUIT)
Q
;
RACNLU(RADFN,RADTI,RACNI) ; Select Case Number
;
N RANOSCRN S RANOSCRN="" ; Don't limit cases to current Imaging Type
S (RADFN,RADTI,RADFN)=""
D ^RACNLU
Q X
;
RESEND(RADFN,RADTI,RACNI,QUIT) ; re-send exam message(s) to HL7 subscribers
;
N RAED,RASSSX,RARPST ;added RASSSX,RARPST, RA*5*95
;
S QUIT=0
I '$D(DT) D ^%DT S DT=Y
;
S RAED=$$RAED(RADFN,RADTI,RACNI)
S QUIT=$$OK(RADFN,RADTI,RACNI)
I QUIT>0 D
.I RAED[",REG," D
..D EN^DDIOL("Re-sending 'EXAM REGISTERED' HL7 message...",,"!!,?6") ;p178/KLM - correct spelling of 'REGISTERED'
..D REG^RAHLRPC
.I RAED[",CANCEL," D
..D EN^DDIOL("Re-sending 'EXAM CANCELLED' HL7 message...",,"!,?6")
..D CANCEL^RAHLRPC
.I RAED[",EXAM," D
..S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",30)="" ;Reset sent flag
..D EN^DDIOL("Re-sending 'EXAMINED' HL7 message...",,"!,?6")
..N RAEXMDUN D 1^RAHLRPC ;*60 Newed RAEXMDUN to prevent variable leak
.I RAED[",RPT," D
..D EN^DDIOL("Re-sending 'REPORT VERIFIED' HL7 message...",,"!,?6")
..;If EF report, set up RASSSX() to exclude VR subscribers, RA*5*95
..I $G(RARPST)="EF" D HLXMSG^RARTE5
..D RPT^RAHLRPC
Q
;
RAED(RADFN,RADTI,RACNI) ; identify correct ^RAHLRPC entry point(s)
;
; removed RARPTST from new, RA*5*95
N RASTAT,RAIMTYP,RAORD,RETURN
S (RARPST,RASTAT)=""
;
S RETURN=",REG,"
;
S RASTAT=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,3,"I")
;
S RAIMTYP=$$GET1^DIQ(72,+RASTAT,7)
S RAORD=$$GET1^DIQ(72,+RASTAT,3)
;
S:RAORD=0 RETURN=RETURN_"CANCEL,"
;
I $$GET1^DIQ(72,+RASTAT,8)="YES" D ; Generate Examined HL7 Message
.S RETURN=RETURN_"EXAM,"
;
I RETURN'[",EXAM," D
.; also check previous statuses for 'Generate Examined HL7 Message'
.F S RAORD=$O(^RA(72,"AA",RAIMTYP,RAORD),-1) Q:+RAORD<1 D Q:RETURN[",EXAM,"
..S RASTAT=$O(^RA(72,"AA",RAIMTYP,RAORD,0))
..I $$GET1^DIQ(72,+RASTAT,8)="YES" S RETURN=RETURN_"EXAM,"
;
I RARPT]"" D ; Check if Verified or Elect. Filed report exists
.S RARPST=$$GET1^DIQ(74,RARPT,5,"I")
.I "^V^EF^"[("^"_RARPST_"^") S RETURN=RETURN_"RPT," ;RA*5*95
;
Q RETURN
;
OK(RADFN,RADTI,RACNI) ; Get User to confirm continue
;
N X,RAEXST
;
S RAEXST=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,3)
;
S X="",$P(X,"=",70)=""
D EN^DDIOL(X,"","!?5")
S DIR("A")="Re-send all HL7 messages for this '"_RAEXST_"' case?"
S DIR(0)="Y",DIR("B")="YES" D ^DIR
I Y="^" Q -1
Q Y
;
SETVARS ; Setup key Rad/Nuc Med variables
;
I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0)
Q:'($D(RACCESS(DUZ))\10) ; user does not have location access
I $G(RAIMGTY)="" D SETVARS^RAPSET1(1) K:$G(RAIMGTY)="" XQUIT
Q
;
RAADT ;Send patient demographic update (A47/A08) to PACS - P137/KLM
;check if MAG*3*183 is installed
I '$$PATCH^XPDUTL("MAG*3.0*183") W !,"You need imaging patch MAG*3.0*183 installed to use this option!" Q
;check if the IHE interface is enabled
;Get appropriate entry from IMAGING SITE PARAMETERS based on institution from Kernel Site Params
N RA20061 S RA20061=$O(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),"")) Q:RA20061<1 ;DBIA 2541,6860
I $$GET1^DIQ(2006.1,RA20061,3.01,"I")'="Y" W !!,"IHE is not enabled!",!,"See MAG*3.0*183 patch instructions to setup/enable ADT messages to PACS." Q
W !!,"This option will send patient demographic updates for selected patients.",!
W !,"It is recommended that you task this if you select 'ALL' patients.",!!
N RADFN,DIR,Y
S RADIC="^RADPT(",RADIC(0)="QEAMZ",RAUTIL="RA PATA08"
S RADIC("A")="Select Patient(s): "
W !! D EN1^RASELCT(.RADIC,RAUTIL)
K DIC,RADIC,RAUTIL
I $O(^TMP($J,"RA PATA08",""))="" W !!?3,$C(7),"No Patient selected." G EXIT
S %=1 W !,"Would you like to task this Job" D YN^DICN G:%<1 EXIT
I %=1 D G EXIT
.S ZTIO="",ZTSAVE("^TMP($J,""RA PATA08"",")=""
.S ZTDESC="Rad/Nuc Med Patient Demographic Update to PACS",ZTRTN="TADT^RAHLRS"
.D ^%ZTLOAD
.I $D(ZTSK) W !,"Task# "_ZTSK,!!
.Q
TADT ;task entry or fall through
S RACT=0
S RAPN="" F S RAPN=$O(^TMP($J,"RA PATA08",RAPN)) Q:RAPN="" D
.S RADFN=0 F S RADFN=$O(^TMP($J,"RA PATA08",RAPN,RADFN)) Q:RADFN="" D
..D SENDA08^MAGDHLE(RADFN)
..S RACT=RACT+1
..Q
.Q
I '$D(ZTQUEUED) W !!,"Demographic updates sent for "_RACT_" patients"
EXIT K ^TMP($J,"RA PATA08"),RAPN,RADFN,ZTDESC,ZTRTN,RACT,ZTSAVE,ZTIO,ZTSK,ZTQUEUED,%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAHLRS 5021 printed Jun 11, 2024@22:21:40 Page 2
RAHLRS ;HIRMFO/CRT/PDW - Resend HL7 messages for selected cases ; Jan 13, 2021@12:17:40
+1 ;;5.0;Radiology/Nuclear Medicine;**25,54,60,71,82,95,137,156,178**;Mar 16, 1998;Build 2
+2 ;
+3 ; Utility to RESEND HL7 messages
+4 ;
+5 ;Integration Agreements
+6 ;----------------------
+7 ;SENDA08^MAGDHLE (6761 - Private)
+8 ;^MAG(2006.1, IHE flag (6860 - Private)
+9 ;$$PATCH^XPDUTL (10141 - Supported)
+10 ;$$KSP^XUPARAM("INST") (2541 - Supported)
+11 ;
+12 ;;02/14/2006 BAY/KAM RA*5*71 Add ability to update exam data to V/R
+13 NEW RACNI,RADFN,RADTI,RARPT,X
+14 ;
+15 DO SETVARS
if $GET(RAIMGTY)=""
QUIT
+16 ;
+17 FOR
SET X=$$RACNLU(.RADFN,.RADTI,.RACNI)
if +X'>0
QUIT
Begin DoDot:1
+18 DO RESEND(RADFN,RADTI,RACNI,.QUIT)
End DoDot:1
if QUIT<0
QUIT
+19 QUIT
+20 ;
RACNLU(RADFN,RADTI,RACNI) ; Select Case Number
+1 ;
+2 ; Don't limit cases to current Imaging Type
NEW RANOSCRN
SET RANOSCRN=""
+3 SET (RADFN,RADTI,RADFN)=""
+4 DO ^RACNLU
+5 QUIT X
+6 ;
RESEND(RADFN,RADTI,RACNI,QUIT) ; re-send exam message(s) to HL7 subscribers
+1 ;
+2 ;added RASSSX,RARPST, RA*5*95
NEW RAED,RASSSX,RARPST
+3 ;
+4 SET QUIT=0
+5 IF '$DATA(DT)
DO ^%DT
SET DT=Y
+6 ;
+7 SET RAED=$$RAED(RADFN,RADTI,RACNI)
+8 SET QUIT=$$OK(RADFN,RADTI,RACNI)
+9 IF QUIT>0
Begin DoDot:1
+10 IF RAED[",REG,"
Begin DoDot:2
+11 ;p178/KLM - correct spelling of 'REGISTERED'
DO EN^DDIOL("Re-sending 'EXAM REGISTERED' HL7 message...",,"!!,?6")
+12 DO REG^RAHLRPC
End DoDot:2
+13 IF RAED[",CANCEL,"
Begin DoDot:2
+14 DO EN^DDIOL("Re-sending 'EXAM CANCELLED' HL7 message...",,"!,?6")
+15 DO CANCEL^RAHLRPC
End DoDot:2
+16 IF RAED[",EXAM,"
Begin DoDot:2
+17 ;Reset sent flag
SET $PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",30)=""
+18 DO EN^DDIOL("Re-sending 'EXAMINED' HL7 message...",,"!,?6")
+19 ;*60 Newed RAEXMDUN to prevent variable leak
NEW RAEXMDUN
DO 1^RAHLRPC
End DoDot:2
+20 IF RAED[",RPT,"
Begin DoDot:2
+21 DO EN^DDIOL("Re-sending 'REPORT VERIFIED' HL7 message...",,"!,?6")
+22 ;If EF report, set up RASSSX() to exclude VR subscribers, RA*5*95
+23 IF $GET(RARPST)="EF"
DO HLXMSG^RARTE5
+24 DO RPT^RAHLRPC
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
RAED(RADFN,RADTI,RACNI) ; identify correct ^RAHLRPC entry point(s)
+1 ;
+2 ; removed RARPTST from new, RA*5*95
+3 NEW RASTAT,RAIMTYP,RAORD,RETURN
+4 SET (RARPST,RASTAT)=""
+5 ;
+6 SET RETURN=",REG,"
+7 ;
+8 SET RASTAT=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,3,"I")
+9 ;
+10 SET RAIMTYP=$$GET1^DIQ(72,+RASTAT,7)
+11 SET RAORD=$$GET1^DIQ(72,+RASTAT,3)
+12 ;
+13 if RAORD=0
SET RETURN=RETURN_"CANCEL,"
+14 ;
+15 ; Generate Examined HL7 Message
IF $$GET1^DIQ(72,+RASTAT,8)="YES"
Begin DoDot:1
+16 SET RETURN=RETURN_"EXAM,"
End DoDot:1
+17 ;
+18 IF RETURN'[",EXAM,"
Begin DoDot:1
+19 ; also check previous statuses for 'Generate Examined HL7 Message'
+20 FOR
SET RAORD=$ORDER(^RA(72,"AA",RAIMTYP,RAORD),-1)
if +RAORD<1
QUIT
Begin DoDot:2
+21 SET RASTAT=$ORDER(^RA(72,"AA",RAIMTYP,RAORD,0))
+22 IF $$GET1^DIQ(72,+RASTAT,8)="YES"
SET RETURN=RETURN_"EXAM,"
End DoDot:2
if RETURN[",EXAM,"
QUIT
End DoDot:1
+23 ;
+24 ; Check if Verified or Elect. Filed report exists
IF RARPT]""
Begin DoDot:1
+25 SET RARPST=$$GET1^DIQ(74,RARPT,5,"I")
+26 ;RA*5*95
IF "^V^EF^"[("^"_RARPST_"^")
SET RETURN=RETURN_"RPT,"
End DoDot:1
+27 ;
+28 QUIT RETURN
+29 ;
OK(RADFN,RADTI,RACNI) ; Get User to confirm continue
+1 ;
+2 NEW X,RAEXST
+3 ;
+4 SET RAEXST=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,3)
+5 ;
+6 SET X=""
SET $PIECE(X,"=",70)=""
+7 DO EN^DDIOL(X,"","!?5")
+8 SET DIR("A")="Re-send all HL7 messages for this '"_RAEXST_"' case?"
+9 SET DIR(0)="Y"
SET DIR("B")="YES"
DO ^DIR
+10 IF Y="^"
QUIT -1
+11 QUIT Y
+12 ;
SETVARS ; Setup key Rad/Nuc Med variables
+1 ;
+2 IF $ORDER(RACCESS(DUZ,""))=""
DO SETVARS^RAPSET1(0)
+3 ; user does not have location access
if '($DATA(RACCESS(DUZ))\10)
QUIT
+4 IF $GET(RAIMGTY)=""
DO SETVARS^RAPSET1(1)
if $GET(RAIMGTY)=""
KILL XQUIT
+5 QUIT
+6 ;
RAADT ;Send patient demographic update (A47/A08) to PACS - P137/KLM
+1 ;check if MAG*3*183 is installed
+2 IF '$$PATCH^XPDUTL("MAG*3.0*183")
WRITE !,"You need imaging patch MAG*3.0*183 installed to use this option!"
QUIT
+3 ;check if the IHE interface is enabled
+4 ;Get appropriate entry from IMAGING SITE PARAMETERS based on institution from Kernel Site Params
+5 ;DBIA 2541,6860
NEW RA20061
SET RA20061=$ORDER(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),""))
if RA20061<1
QUIT
+6 IF $$GET1^DIQ(2006.1,RA20061,3.01,"I")'="Y"
WRITE !!,"IHE is not enabled!",!,"See MAG*3.0*183 patch instructions to setup/enable ADT messages to PACS."
QUIT
+7 WRITE !!,"This option will send patient demographic updates for selected patients.",!
+8 WRITE !,"It is recommended that you task this if you select 'ALL' patients.",!!
+9 NEW RADFN,DIR,Y
+10 SET RADIC="^RADPT("
SET RADIC(0)="QEAMZ"
SET RAUTIL="RA PATA08"
+11 SET RADIC("A")="Select Patient(s): "
+12 WRITE !!
DO EN1^RASELCT(.RADIC,RAUTIL)
+13 KILL DIC,RADIC,RAUTIL
+14 IF $ORDER(^TMP($JOB,"RA PATA08",""))=""
WRITE !!?3,$CHAR(7),"No Patient selected."
GOTO EXIT
+15 SET %=1
WRITE !,"Would you like to task this Job"
DO YN^DICN
if %<1
GOTO EXIT
+16 IF %=1
Begin DoDot:1
+17 SET ZTIO=""
SET ZTSAVE("^TMP($J,""RA PATA08"",")=""
+18 SET ZTDESC="Rad/Nuc Med Patient Demographic Update to PACS"
SET ZTRTN="TADT^RAHLRS"
+19 DO ^%ZTLOAD
+20 IF $DATA(ZTSK)
WRITE !,"Task# "_ZTSK,!!
+21 QUIT
End DoDot:1
GOTO EXIT
TADT ;task entry or fall through
+1 SET RACT=0
+2 SET RAPN=""
FOR
SET RAPN=$ORDER(^TMP($JOB,"RA PATA08",RAPN))
if RAPN=""
QUIT
Begin DoDot:1
+3 SET RADFN=0
FOR
SET RADFN=$ORDER(^TMP($JOB,"RA PATA08",RAPN,RADFN))
if RADFN=""
QUIT
Begin DoDot:2
+4 DO SENDA08^MAGDHLE(RADFN)
+5 SET RACT=RACT+1
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 IF '$DATA(ZTQUEUED)
WRITE !!,"Demographic updates sent for "_RACT_" patients"
EXIT KILL ^TMP($JOB,"RA PATA08"),RAPN,RADFN,ZTDESC,ZTRTN,RACT,ZTSAVE,ZTIO,ZTSK,ZTQUEUED,%
+1 QUIT
