- 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 Feb 19, 2025@00:01:51 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