RAHLRPRO ;WOIFO/KLM - Radiology HL7 Reprocessing Utilities ; Jun 20, 2025@13:09:53
;;5.0;Radiology/Nuclear Medicine;**220,227**;Mar 16, 1998;Build 2
;
; This routine is called by the scheduled option 'Reprocess locked study accession error'
; It traverses the index on a REPROCESS flag of the HL7 MESSAGE EXCEPTIONS file for
; result messages rejected with a "Lock of Accession.." or "Lock of Report.." error
; and calls the HL7 utility to reprocess the message.
;
; Routine/File IA Type
; -------------------------------------
; $$REPROC^HLUTL 2434 (S)
; ^HLMA (fld #2) 3244 (C)
;
;
;
REPROC ;Record locked error - HL7 MESSAGE EXCEPTIONS file (#79.3)
N RA773,RARTN,RAN,RAERR,RAEXDA,RAMID,RAR,RARST,RAREP,RAR,RADFN,RADTI,RACNI,RADC
S RARTN="RAHLTCPB"
S RAEXDA=0 F S RAEXDA=$O(^RA(79.3,"C","Y",RAEXDA)) Q:RAEXDA="" D
.;get message IEN/check if purged
.I $$CHECKHL7(RAEXDA)=1 D DFLAG(RAEXDA) Q ;Message purged, clear flag
.;get ACC# / Check lock and report status
.S RAERR=$$GET1^DIQ(79.3,RAEXDA,1)
.K RAN S RAN=$P($P(RAERR,": ",2)," ") Q:RAN=""
.I $$CHECKLOC(RAN)=1 Q ;do not clear flag
.S RAR=$$GETRPT(RAN)
.I $$CHECKRPT(RAN)=1 D DFLAG(RAEXDA) Q ;Report already filed, clear flag
.;call REPROC^HLUTIL
.K RAREP S RAREP=$$REPROC^HLUTIL($$GET1^DIQ(79.3,RAEXDA,.05,"I"),RARTN)
.;Check if successful
.I RAREP=0 D UPDATEX(RAEXDA,RAN)
.Q
Q
CHECKHL7(RAX) ;Check Hl7 message status
;RAX is the IEN from 79.3
I RAX="" Q 1
N RA773,RAMID,RAMST
S RA773=$$GET1^DIQ(79.3,RAEXDA,.05,"I") I RA773="" Q 1
S RAMID=$$GET1^DIQ(773,RA773,2) I RAMID="" Q 1
S RAMST=$$MSGSTAT^HLUTIL(RAMID)
I +RAMST'=3 Q 1 ;3 means HL7 message successfully completed and not yet purged
Q 0
CHECKLOC(RAN) ;Check if the exam record is still locked
;RAN is the Accession number
I $G(RAN)="" Q 1
N RADC,RADFN,RADTI
S RADC=$S($L($P(RAN,"-"))=3:"ADC1",1:"ADC") I $G(RADC)="" Q 1
S RADFN=$O(^RADPT(RADC,RAN,"")) I $G(RADFN)="" Q 1
S RADTI=$O(^RADPT(RADC,RAN,RADFN,"")) I $G(RADTI)="" Q 1
L +^RADPT(RADFN,"DT",RADTI):2 I '$T Q 1 ;record still locked
L -^RADPT(RADFN,"DT",RADTI) ;unlock it
Q 0
CHECKRPT(RAN) ;Check if report exists and status
;RAN is the Accession number
I $G(RAN)="" Q 1
N RADC,RADFN,RADTI,RACNI,RAR
;p227: could be printset - get rpt pointer from exam
S RAR=$$GETRPT(RAN) I $G(RAR)<1 Q 0
;report exists - check status
I $G(RAR)>0 S RARST=$$GET1^DIQ(74,RAR,5,"I")
I $G(RARST)="V"!($G(RARST)="EF") Q 1 ;Report already filed
Q 0
UPDATEX(RAX,RAN) ;Clear Reprocess Flag
;RAX is the IEN from 79.3
;RAN is the accession number
Q:$G(RAX)=""!($G(RAN)="")
N RARST,RAR
S RAR=$$GETRPT(RAN) Q:$G(RAR)<1
S RARST=$$GET1^DIQ(74,RAR,5,"I")
I ($G(RARST)'="V"),($G(RARST)'="R") Q ;p226v2 Not verified or prelim
D DFLAG(RAX)
Q
DFLAG(RAX) ;delete reprocess flag
Q:RAX=""
N RAFDA
S RAFDA(79.3,RAEXDA_",",.07)="@"
D FILE^DIE("","RAFDA")
Q
SANABLE ;Enable reprocessing for a sending application
;Called by option RASAN ENABLE REPROCESSING
S DIC="^RA(79.7,",DIC(0)="AEMQL",DLAYGO=79.7 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y Q
S DA=+Y,DIE="^RA(79.7,",DR="1.6;1.7" D ^DIE
K DA,DIE,DR,DIC,D,D0,DI,DTO,X G SANABLE
Q
GETRPT(RAN) ;p227 - pset handling, get report pointer from 70.03;17
;RAN is the Accession number
I $G(RAN)="" Q 0
N RADFN,RADTI,RACNI,RADC,RAR
S RADC=$S($L($P(RAN,"-"))=3:"ADC1",1:"ADC") I $G(RADC)="" Q 0
S RADFN=$O(^RADPT(RADC,RAN,"")) I $G(RADFN)="" Q 0
S RADTI=$O(^RADPT(RADC,RAN,RADFN,"")) I $G(RADTI)="" Q 0
S RACNI=$O(^RADPT(RADC,RAN,RADFN,RADTI,"")) I $G(RACNI)="" Q 0
S RAR=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,17) I $G(RAR)="" Q 0
Q $G(RAR)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAHLRPRO 3743 printed Aug 26, 2025@22:51:15 Page 2
RAHLRPRO ;WOIFO/KLM - Radiology HL7 Reprocessing Utilities ; Jun 20, 2025@13:09:53
+1 ;;5.0;Radiology/Nuclear Medicine;**220,227**;Mar 16, 1998;Build 2
+2 ;
+3 ; This routine is called by the scheduled option 'Reprocess locked study accession error'
+4 ; It traverses the index on a REPROCESS flag of the HL7 MESSAGE EXCEPTIONS file for
+5 ; result messages rejected with a "Lock of Accession.." or "Lock of Report.." error
+6 ; and calls the HL7 utility to reprocess the message.
+7 ;
+8 ; Routine/File IA Type
+9 ; -------------------------------------
+10 ; $$REPROC^HLUTL 2434 (S)
+11 ; ^HLMA (fld #2) 3244 (C)
+12 ;
+13 ;
+14 ;
REPROC ;Record locked error - HL7 MESSAGE EXCEPTIONS file (#79.3)
+1 NEW RA773,RARTN,RAN,RAERR,RAEXDA,RAMID,RAR,RARST,RAREP,RAR,RADFN,RADTI,RACNI,RADC
+2 SET RARTN="RAHLTCPB"
+3 SET RAEXDA=0
FOR
SET RAEXDA=$ORDER(^RA(79.3,"C","Y",RAEXDA))
if RAEXDA=""
QUIT
Begin DoDot:1
+4 ;get message IEN/check if purged
+5 ;Message purged, clear flag
IF $$CHECKHL7(RAEXDA)=1
DO DFLAG(RAEXDA)
QUIT
+6 ;get ACC# / Check lock and report status
+7 SET RAERR=$$GET1^DIQ(79.3,RAEXDA,1)
+8 KILL RAN
SET RAN=$PIECE($PIECE(RAERR,": ",2)," ")
if RAN=""
QUIT
+9 ;do not clear flag
IF $$CHECKLOC(RAN)=1
QUIT
+10 SET RAR=$$GETRPT(RAN)
+11 ;Report already filed, clear flag
IF $$CHECKRPT(RAN)=1
DO DFLAG(RAEXDA)
QUIT
+12 ;call REPROC^HLUTIL
+13 KILL RAREP
SET RAREP=$$REPROC^HLUTIL($$GET1^DIQ(79.3,RAEXDA,.05,"I"),RARTN)
+14 ;Check if successful
+15 IF RAREP=0
DO UPDATEX(RAEXDA,RAN)
+16 QUIT
End DoDot:1
+17 QUIT
CHECKHL7(RAX) ;Check Hl7 message status
+1 ;RAX is the IEN from 79.3
+2 IF RAX=""
QUIT 1
+3 NEW RA773,RAMID,RAMST
+4 SET RA773=$$GET1^DIQ(79.3,RAEXDA,.05,"I")
IF RA773=""
QUIT 1
+5 SET RAMID=$$GET1^DIQ(773,RA773,2)
IF RAMID=""
QUIT 1
+6 SET RAMST=$$MSGSTAT^HLUTIL(RAMID)
+7 ;3 means HL7 message successfully completed and not yet purged
IF +RAMST'=3
QUIT 1
+8 QUIT 0
CHECKLOC(RAN) ;Check if the exam record is still locked
+1 ;RAN is the Accession number
+2 IF $GET(RAN)=""
QUIT 1
+3 NEW RADC,RADFN,RADTI
+4 SET RADC=$SELECT($LENGTH($PIECE(RAN,"-"))=3:"ADC1",1:"ADC")
IF $GET(RADC)=""
QUIT 1
+5 SET RADFN=$ORDER(^RADPT(RADC,RAN,""))
IF $GET(RADFN)=""
QUIT 1
+6 SET RADTI=$ORDER(^RADPT(RADC,RAN,RADFN,""))
IF $GET(RADTI)=""
QUIT 1
+7 ;record still locked
LOCK +^RADPT(RADFN,"DT",RADTI):2
IF '$TEST
QUIT 1
+8 ;unlock it
LOCK -^RADPT(RADFN,"DT",RADTI)
+9 QUIT 0
CHECKRPT(RAN) ;Check if report exists and status
+1 ;RAN is the Accession number
+2 IF $GET(RAN)=""
QUIT 1
+3 NEW RADC,RADFN,RADTI,RACNI,RAR
+4 ;p227: could be printset - get rpt pointer from exam
+5 SET RAR=$$GETRPT(RAN)
IF $GET(RAR)<1
QUIT 0
+6 ;report exists - check status
+7 IF $GET(RAR)>0
SET RARST=$$GET1^DIQ(74,RAR,5,"I")
+8 ;Report already filed
IF $GET(RARST)="V"!($GET(RARST)="EF")
QUIT 1
+9 QUIT 0
UPDATEX(RAX,RAN) ;Clear Reprocess Flag
+1 ;RAX is the IEN from 79.3
+2 ;RAN is the accession number
+3 if $GET(RAX)=""!($GET(RAN)="")
QUIT
+4 NEW RARST,RAR
+5 SET RAR=$$GETRPT(RAN)
if $GET(RAR)<1
QUIT
+6 SET RARST=$$GET1^DIQ(74,RAR,5,"I")
+7 ;p226v2 Not verified or prelim
IF ($GET(RARST)'="V")
IF ($GET(RARST)'="R")
QUIT
+8 DO DFLAG(RAX)
+9 QUIT
DFLAG(RAX) ;delete reprocess flag
+1 if RAX=""
QUIT
+2 NEW RAFDA
+3 SET RAFDA(79.3,RAEXDA_",",.07)="@"
+4 DO FILE^DIE("","RAFDA")
+5 QUIT
SANABLE ;Enable reprocessing for a sending application
+1 ;Called by option RASAN ENABLE REPROCESSING
+2 SET DIC="^RA(79.7,"
SET DIC(0)="AEMQL"
SET DLAYGO=79.7
WRITE !
DO ^DIC
KILL DIC,DLAYGO
IF Y<0
KILL D,X,Y
QUIT
+3 SET DA=+Y
SET DIE="^RA(79.7,"
SET DR="1.6;1.7"
DO ^DIE
+4 KILL DA,DIE,DR,DIC,D,D0,DI,DTO,X
GOTO SANABLE
+5 QUIT
GETRPT(RAN) ;p227 - pset handling, get report pointer from 70.03;17
+1 ;RAN is the Accession number
+2 IF $GET(RAN)=""
QUIT 0
+3 NEW RADFN,RADTI,RACNI,RADC,RAR
+4 SET RADC=$SELECT($LENGTH($PIECE(RAN,"-"))=3:"ADC1",1:"ADC")
IF $GET(RADC)=""
QUIT 0
+5 SET RADFN=$ORDER(^RADPT(RADC,RAN,""))
IF $GET(RADFN)=""
QUIT 0
+6 SET RADTI=$ORDER(^RADPT(RADC,RAN,RADFN,""))
IF $GET(RADTI)=""
QUIT 0
+7 SET RACNI=$ORDER(^RADPT(RADC,RAN,RADFN,RADTI,""))
IF $GET(RACNI)=""
QUIT 0
+8 SET RAR=$PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,17)
IF $GET(RAR)=""
QUIT 0
+9 QUIT $GET(RAR)
