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

RAHLRS.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Utility to RESEND HL7 messages
  1. ;
  1. ;Integration Agreements
  1. ;----------------------
  1. ;SENDA08^MAGDHLE (6761 - Private)
  1. ;^MAG(2006.1, IHE flag (6860 - Private)
  1. ;$$PATCH^XPDUTL (10141 - Supported)
  1. ;$$KSP^XUPARAM("INST") (2541 - Supported)
  1. ;
  1. ;;02/14/2006 BAY/KAM RA*5*71 Add ability to update exam data to V/R
  1. N RACNI,RADFN,RADTI,RARPT,X
  1. ;
  1. D SETVARS Q:$G(RAIMGTY)=""
  1. ;
  1. F S X=$$RACNLU(.RADFN,.RADTI,.RACNI) Q:+X'>0 D Q:QUIT<0
  1. .D RESEND(RADFN,RADTI,RACNI,.QUIT)
  1. Q
  1. ;
  1. RACNLU(RADFN,RADTI,RACNI) ; Select Case Number
  1. ;
  1. N RANOSCRN S RANOSCRN="" ; Don't limit cases to current Imaging Type
  1. S (RADFN,RADTI,RADFN)=""
  1. D ^RACNLU
  1. Q X
  1. ;
  1. RESEND(RADFN,RADTI,RACNI,QUIT) ; re-send exam message(s) to HL7 subscribers
  1. ;
  1. N RAED,RASSSX,RARPST ;added RASSSX,RARPST, RA*5*95
  1. ;
  1. S QUIT=0
  1. I '$D(DT) D ^%DT S DT=Y
  1. ;
  1. S RAED=$$RAED(RADFN,RADTI,RACNI)
  1. S QUIT=$$OK(RADFN,RADTI,RACNI)
  1. I QUIT>0 D
  1. .I RAED[",REG," D
  1. ..D EN^DDIOL("Re-sending 'EXAM REGISTERED' HL7 message...",,"!!,?6") ;p178/KLM - correct spelling of 'REGISTERED'
  1. ..D REG^RAHLRPC
  1. .I RAED[",CANCEL," D
  1. ..D EN^DDIOL("Re-sending 'EXAM CANCELLED' HL7 message...",,"!,?6")
  1. ..D CANCEL^RAHLRPC
  1. .I RAED[",EXAM," D
  1. ..S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",30)="" ;Reset sent flag
  1. ..D EN^DDIOL("Re-sending 'EXAMINED' HL7 message...",,"!,?6")
  1. ..N RAEXMDUN D 1^RAHLRPC ;*60 Newed RAEXMDUN to prevent variable leak
  1. .I RAED[",RPT," D
  1. ..D EN^DDIOL("Re-sending 'REPORT VERIFIED' HL7 message...",,"!,?6")
  1. ..;If EF report, set up RASSSX() to exclude VR subscribers, RA*5*95
  1. ..I $G(RARPST)="EF" D HLXMSG^RARTE5
  1. ..D RPT^RAHLRPC
  1. Q
  1. ;
  1. RAED(RADFN,RADTI,RACNI) ; identify correct ^RAHLRPC entry point(s)
  1. ;
  1. ; removed RARPTST from new, RA*5*95
  1. N RASTAT,RAIMTYP,RAORD,RETURN
  1. S (RARPST,RASTAT)=""
  1. ;
  1. S RETURN=",REG,"
  1. ;
  1. S RASTAT=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,3,"I")
  1. ;
  1. S RAIMTYP=$$GET1^DIQ(72,+RASTAT,7)
  1. S RAORD=$$GET1^DIQ(72,+RASTAT,3)
  1. ;
  1. S:RAORD=0 RETURN=RETURN_"CANCEL,"
  1. ;
  1. I $$GET1^DIQ(72,+RASTAT,8)="YES" D ; Generate Examined HL7 Message
  1. .S RETURN=RETURN_"EXAM,"
  1. ;
  1. I RETURN'[",EXAM," D
  1. .; also check previous statuses for 'Generate Examined HL7 Message'
  1. .F S RAORD=$O(^RA(72,"AA",RAIMTYP,RAORD),-1) Q:+RAORD<1 D Q:RETURN[",EXAM,"
  1. ..S RASTAT=$O(^RA(72,"AA",RAIMTYP,RAORD,0))
  1. ..I $$GET1^DIQ(72,+RASTAT,8)="YES" S RETURN=RETURN_"EXAM,"
  1. ;
  1. I RARPT]"" D ; Check if Verified or Elect. Filed report exists
  1. .S RARPST=$$GET1^DIQ(74,RARPT,5,"I")
  1. .I "^V^EF^"[("^"_RARPST_"^") S RETURN=RETURN_"RPT," ;RA*5*95
  1. ;
  1. Q RETURN
  1. ;
  1. OK(RADFN,RADTI,RACNI) ; Get User to confirm continue
  1. ;
  1. N X,RAEXST
  1. ;
  1. S RAEXST=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,3)
  1. ;
  1. S X="",$P(X,"=",70)=""
  1. D EN^DDIOL(X,"","!?5")
  1. S DIR("A")="Re-send all HL7 messages for this '"_RAEXST_"' case?"
  1. S DIR(0)="Y",DIR("B")="YES" D ^DIR
  1. I Y="^" Q -1
  1. Q Y
  1. ;
  1. SETVARS ; Setup key Rad/Nuc Med variables
  1. ;
  1. I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0)
  1. Q:'($D(RACCESS(DUZ))\10) ; user does not have location access
  1. I $G(RAIMGTY)="" D SETVARS^RAPSET1(1) K:$G(RAIMGTY)="" XQUIT
  1. Q
  1. ;
  1. RAADT ;Send patient demographic update (A47/A08) to PACS - P137/KLM
  1. ;check if MAG*3*183 is installed
  1. I '$$PATCH^XPDUTL("MAG*3.0*183") W !,"You need imaging patch MAG*3.0*183 installed to use this option!" Q
  1. ;check if the IHE interface is enabled
  1. ;Get appropriate entry from IMAGING SITE PARAMETERS based on institution from Kernel Site Params
  1. N RA20061 S RA20061=$O(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),"")) Q:RA20061<1 ;DBIA 2541,6860
  1. 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
  1. W !!,"This option will send patient demographic updates for selected patients.",!
  1. W !,"It is recommended that you task this if you select 'ALL' patients.",!!
  1. N RADFN,DIR,Y
  1. S RADIC="^RADPT(",RADIC(0)="QEAMZ",RAUTIL="RA PATA08"
  1. S RADIC("A")="Select Patient(s): "
  1. W !! D EN1^RASELCT(.RADIC,RAUTIL)
  1. K DIC,RADIC,RAUTIL
  1. I $O(^TMP($J,"RA PATA08",""))="" W !!?3,$C(7),"No Patient selected." G EXIT
  1. S %=1 W !,"Would you like to task this Job" D YN^DICN G:%<1 EXIT
  1. I %=1 D G EXIT
  1. .S ZTIO="",ZTSAVE("^TMP($J,""RA PATA08"",")=""
  1. .S ZTDESC="Rad/Nuc Med Patient Demographic Update to PACS",ZTRTN="TADT^RAHLRS"
  1. .D ^%ZTLOAD
  1. .I $D(ZTSK) W !,"Task# "_ZTSK,!!
  1. .Q
  1. TADT ;task entry or fall through
  1. S RACT=0
  1. S RAPN="" F S RAPN=$O(^TMP($J,"RA PATA08",RAPN)) Q:RAPN="" D
  1. .S RADFN=0 F S RADFN=$O(^TMP($J,"RA PATA08",RAPN,RADFN)) Q:RADFN="" D
  1. ..D SENDA08^MAGDHLE(RADFN)
  1. ..S RACT=RACT+1
  1. ..Q
  1. .Q
  1. I '$D(ZTQUEUED) W !!,"Demographic updates sent for "_RACT_" patients"
  1. EXIT K ^TMP($J,"RA PATA08"),RAPN,RADFN,ZTDESC,ZTRTN,RACT,ZTSAVE,ZTIO,ZTSK,ZTQUEUED,%
  1. Q