LA7UTILB ;DALOI/JMC - Reprocess Lab HL7 Incoming Messages ;11/18/15 17:19
;;5.2;AUTOMATED LAB INSTRUMENTS;**74,88**;Sep 27, 1994;Build 10
;
EN ; Select a Lab HL7 message to reprocess.
N DIC,DIR,DIROUT,DIRUT,DTOUT,FDA,LA7DIE,LA76248,LA7I,LA7LIST,LA7X,PARAM,X,Y
;
S PARAM("SHOIDS")=$$GET^XPAR("USR^SYS","LA7UTILA SHOIDS",1,"Q")
S PARAM("SHOIDS LAST")=$$GET^XPAR("USR^SYS","LA7UTILA SHOIDS LAST",1,"Q")
S X=PARAM("SHOIDS")
I X="L" S X=PARAM("SHOIDS LAST")
I X="" S X=PARAM("SHOIDS")
I X="" S X=1
I X'=+X S X=$S(X="Y":1,X="N":0,1:1)
K PARAM
S DIR("B")=$S(X:"YES",1:"NO")
S DIR(0)="Y",DIR("A")="Display identifiers during message selection"
D ^DIR
I $D(DIRUT) Q
I Y<1 S DIC("W")="D DICW^LA7UTILA"
; save PARAM setting
D EN^XPAR("USR","LA7UTILA SHOIDS LAST",1,$S(+Y>0:1,1:0))
S DIC="^LAHM(62.49,",DIC("S")="I $$DICS^LA7UTILB(Y)"
S DIC(0)="EQMZ"
S X=$$SELECT^LRUTIL(.DIC,.LA7LIST,"Message",10,0,1,1)
;
K DIC,DIR
;
; Confirm selection
I $O(LA7LIST(0)) D
. S DIR(0)="YO",DIR("A")="Reprocess these messages",DIR("B")="YES"
. D ^DIR
. I Y'=1 Q
. D SETSTAT,TASK
;
I '$O(LA7LIST(0)) D CHECKQ
;
; Check if auto release master switch parameter is ON (1) then check for any queues needing restarting.
I $$GET^XPAR("SYS^PKG","LA UI AUTO RELEASE MASTER",1,"Q") D CHECKARQ
;
Q
;
;
SETSTAT ; Set status of selected messages to queued for processing
;
;ZEXCEPT: LA76248,LA7LIST
;
N FDA,LA7I,LRDIE
S LA7I=0
F S LA7I=$O(LA7LIST(LA7I)) Q:'LA7I D
. K FDA,LRDIE
. S FDA(1,62.49,LA7I_",",2)="Q"
. D FILE^DIE("","FDA(1)","LA7DIE(1)")
. S LA76248=$P($G(^LAHM(62.49,LA7I,.5)),"^")
. I LA76248 S LA76248(LA76248)=""
;
Q
;
;
TASK ; Task processing routine for each message's respective configuration
;
;ZEXCEPT: LA76248
;
N LA7X
S LA76248=0
F S LA76248=$O(LA76248(LA76248)) Q:'LA76248 D
. S LA7X=$P($G(^LAHM(62.48,LA76248,0)),"^")
. I $G(^LAHM(62.48,LA76248,1))'="" X ^(1) D EN^DDIOL("Queued processing routine for configuration "_LA7X,"","!") Q
. D EN^DDIOL($C(7)_"Unable to queue processing routine for configuration "_LA7X_" - No processing routine","","!")
;
Q
;
;
CHECKQ ; Check "IQ" incoming queued for processing queues in case need to restart.
N DIR,DIRUT,DTOUT,DUOUT,LA76248,LA7CNT,LA7I,LA7J,LA7K,X,Y
S (LA7I,LA7J)=0
F S LA7I=$O(^LAHM(62.48,LA7I)) Q:LA7I<1 D
. I '$P(^LAHM(62.48,LA7I,0),"^",3) Q
. I '$D(^LAHM(62.49,"Q",LA7I,"IQ")) Q
. S (LA7CNT,LA7K)=0
. F S LA7K=$O(^LAHM(62.49,"Q",LA7I,"IQ",LA7K)) Q:LA7K<1 S LA7CNT=LA7CNT+1
. S LA7J=LA7J+1,LA7J(LA7J)=LA7I,DIR("A",LA7J)=LA7J_" "_$P(^LAHM(62.48,LA7I,0),"^")_" (Queue size: "_LA7CNT_")"
I '$O(LA7J(0)) Q
W !!
S DIR(0)="LO^1:"_LA7J
S DIR("A")="Select the number(s) of the configurations to restart"
S DIR("A",.1)="The following configurations have messages queued for processing:",DIR("A",.2)=" ",DIR("A",LA7J+1)=" "
D ^DIR
I $D(DIRUT) Q
S LA7I=0
F LA7I=1:1 S LA7J=$P(Y,",",LA7I) Q:LA7J<1 S LA76248(LA7J(LA7J))=""
I $D(LA76248) D TASK
Q
;
;
CHECKARQ ; Check LAH global for pending auto release results in case need to restart
;
N DIR,DIRUT,DTOUT,DUOUT,LA7CNT,LA7I,LA7J,LA7K,LA7X,LRLL,LWL,X,Y
;
S (LA7I,LA7J)=0
F S LA7I=$O(^LAH(LA7I)) Q:LA7I<1 D
. I '$D(^LAH(LA7I,1,"AUTOREL-UID")) Q
. S (LA7CNT,LA7K)=0
. F S LA7K=$O(^LAH(LA7I,1,"AUTOREL-UID",LA7K)) Q:LA7K="" S LA7CNT=LA7CNT+1
. S LA7J=LA7J+1,LA7J(LA7J)=LA7I,DIR("A",LA7J)=LA7J_" "_$P(^LRO(68.2,LA7I,0),"^")_" (Queue size: "_LA7CNT_" accession"_$S(LA7CNT>1:"s",1:"")_")"
I '$O(LA7J(0)) Q
;
W !!
S DIR(0)="LO^1:"_LA7J
S DIR("A")="Select the number(s) of the LOAD/WORK LIST Auto Release to restart"
S DIR("A",.1)="The following Load Lists have results in the Auto Release queue:",DIR("A",.2)=" ",DIR("A",LA7J+1)=" "
D ^DIR
I $D(DIRUT) Q
;
F LA7I=1:1 S LA7J=$P(Y,",",LA7I) Q:LA7J<1 S LRLL(LA7J(LA7J))=""
;
S LWL=0
F S LWL=$O(LRLL(LWL)) Q:'LWL D
. S LA7X=$P(^LRO(68.2,LWL,0),"^")
. D QLAH^LA7VIN(LWL,"EN^LRVRAR")
. D EN^DDIOL("Queued auto release processing for LOAD/WORK LIST "_LA7X,"","!")
Q
;
;
DICS(DA) ; Perform FileMan DIC screen on lookup
; Call with DA = IEN of entry in file #62.49
; Returns LA7Y = 1 if entry should be selected
; = 0 if not selectable
; Entry should be type (I)ncoming, have a status of (X)purgable, (E)rror or (Q)ueued for processing and
; be related to an message configuration type 1-UI or 10-LEDI.
; Messages for other configuration types should not be reprocessed at this time.
N LA7I,LA7X,LA7Y
S LA7I(0)=$G(^LAHM(62.49,DA,0)),LA7Y=0
I $P(LA7I(0),"^",2)="I",$P(LA7I(0),"^",3)?1(1"X",1"E",1"Q") D
. S LA7X=$P($G(^LAHM(62.49,DA,.5)),"^"),LA7X(0)=$G(^LAHM(62.48,LA7X,0))
. I $P(LA7X(0),"^",9)>0,$P(LA7X(0),"^",9)<11 S LA7Y=1
Q LA7Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7UTILB 4833 printed Apr 09, 2024@20:44:53 Page 2
LA7UTILB ;DALOI/JMC - Reprocess Lab HL7 Incoming Messages ;11/18/15 17:19
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74,88**;Sep 27, 1994;Build 10
+2 ;
EN ; Select a Lab HL7 message to reprocess.
+1 NEW DIC,DIR,DIROUT,DIRUT,DTOUT,FDA,LA7DIE,LA76248,LA7I,LA7LIST,LA7X,PARAM,X,Y
+2 ;
+3 SET PARAM("SHOIDS")=$$GET^XPAR("USR^SYS","LA7UTILA SHOIDS",1,"Q")
+4 SET PARAM("SHOIDS LAST")=$$GET^XPAR("USR^SYS","LA7UTILA SHOIDS LAST",1,"Q")
+5 SET X=PARAM("SHOIDS")
+6 IF X="L"
SET X=PARAM("SHOIDS LAST")
+7 IF X=""
SET X=PARAM("SHOIDS")
+8 IF X=""
SET X=1
+9 IF X'=+X
SET X=$SELECT(X="Y":1,X="N":0,1:1)
+10 KILL PARAM
+11 SET DIR("B")=$SELECT(X:"YES",1:"NO")
+12 SET DIR(0)="Y"
SET DIR("A")="Display identifiers during message selection"
+13 DO ^DIR
+14 IF $DATA(DIRUT)
QUIT
+15 IF Y<1
SET DIC("W")="D DICW^LA7UTILA"
+16 ; save PARAM setting
+17 DO EN^XPAR("USR","LA7UTILA SHOIDS LAST",1,$SELECT(+Y>0:1,1:0))
+18 SET DIC="^LAHM(62.49,"
SET DIC("S")="I $$DICS^LA7UTILB(Y)"
+19 SET DIC(0)="EQMZ"
+20 SET X=$$SELECT^LRUTIL(.DIC,.LA7LIST,"Message",10,0,1,1)
+21 ;
+22 KILL DIC,DIR
+23 ;
+24 ; Confirm selection
+25 IF $ORDER(LA7LIST(0))
Begin DoDot:1
+26 SET DIR(0)="YO"
SET DIR("A")="Reprocess these messages"
SET DIR("B")="YES"
+27 DO ^DIR
+28 IF Y'=1
QUIT
+29 DO SETSTAT
DO TASK
End DoDot:1
+30 ;
+31 IF '$ORDER(LA7LIST(0))
DO CHECKQ
+32 ;
+33 ; Check if auto release master switch parameter is ON (1) then check for any queues needing restarting.
+34 IF $$GET^XPAR("SYS^PKG","LA UI AUTO RELEASE MASTER",1,"Q")
DO CHECKARQ
+35 ;
+36 QUIT
+37 ;
+38 ;
SETSTAT ; Set status of selected messages to queued for processing
+1 ;
+2 ;ZEXCEPT: LA76248,LA7LIST
+3 ;
+4 NEW FDA,LA7I,LRDIE
+5 SET LA7I=0
+6 FOR
SET LA7I=$ORDER(LA7LIST(LA7I))
if 'LA7I
QUIT
Begin DoDot:1
+7 KILL FDA,LRDIE
+8 SET FDA(1,62.49,LA7I_",",2)="Q"
+9 DO FILE^DIE("","FDA(1)","LA7DIE(1)")
+10 SET LA76248=$PIECE($GET(^LAHM(62.49,LA7I,.5)),"^")
+11 IF LA76248
SET LA76248(LA76248)=""
End DoDot:1
+12 ;
+13 QUIT
+14 ;
+15 ;
TASK ; Task processing routine for each message's respective configuration
+1 ;
+2 ;ZEXCEPT: LA76248
+3 ;
+4 NEW LA7X
+5 SET LA76248=0
+6 FOR
SET LA76248=$ORDER(LA76248(LA76248))
if 'LA76248
QUIT
Begin DoDot:1
+7 SET LA7X=$PIECE($GET(^LAHM(62.48,LA76248,0)),"^")
+8 IF $GET(^LAHM(62.48,LA76248,1))'=""
XECUTE ^(1)
DO EN^DDIOL("Queued processing routine for configuration "_LA7X,"","!")
QUIT
+9 DO EN^DDIOL($CHAR(7)_"Unable to queue processing routine for configuration "_LA7X_" - No processing routine","","!")
End DoDot:1
+10 ;
+11 QUIT
+12 ;
+13 ;
CHECKQ ; Check "IQ" incoming queued for processing queues in case need to restart.
+1 NEW DIR,DIRUT,DTOUT,DUOUT,LA76248,LA7CNT,LA7I,LA7J,LA7K,X,Y
+2 SET (LA7I,LA7J)=0
+3 FOR
SET LA7I=$ORDER(^LAHM(62.48,LA7I))
if LA7I<1
QUIT
Begin DoDot:1
+4 IF '$PIECE(^LAHM(62.48,LA7I,0),"^",3)
QUIT
+5 IF '$DATA(^LAHM(62.49,"Q",LA7I,"IQ"))
QUIT
+6 SET (LA7CNT,LA7K)=0
+7 FOR
SET LA7K=$ORDER(^LAHM(62.49,"Q",LA7I,"IQ",LA7K))
if LA7K<1
QUIT
SET LA7CNT=LA7CNT+1
+8 SET LA7J=LA7J+1
SET LA7J(LA7J)=LA7I
SET DIR("A",LA7J)=LA7J_" "_$PIECE(^LAHM(62.48,LA7I,0),"^")_" (Queue size: "_LA7CNT_")"
End DoDot:1
+9 IF '$ORDER(LA7J(0))
QUIT
+10 WRITE !!
+11 SET DIR(0)="LO^1:"_LA7J
+12 SET DIR("A")="Select the number(s) of the configurations to restart"
+13 SET DIR("A",.1)="The following configurations have messages queued for processing:"
SET DIR("A",.2)=" "
SET DIR("A",LA7J+1)=" "
+14 DO ^DIR
+15 IF $DATA(DIRUT)
QUIT
+16 SET LA7I=0
+17 FOR LA7I=1:1
SET LA7J=$PIECE(Y,",",LA7I)
if LA7J<1
QUIT
SET LA76248(LA7J(LA7J))=""
+18 IF $DATA(LA76248)
DO TASK
+19 QUIT
+20 ;
+21 ;
CHECKARQ ; Check LAH global for pending auto release results in case need to restart
+1 ;
+2 NEW DIR,DIRUT,DTOUT,DUOUT,LA7CNT,LA7I,LA7J,LA7K,LA7X,LRLL,LWL,X,Y
+3 ;
+4 SET (LA7I,LA7J)=0
+5 FOR
SET LA7I=$ORDER(^LAH(LA7I))
if LA7I<1
QUIT
Begin DoDot:1
+6 IF '$DATA(^LAH(LA7I,1,"AUTOREL-UID"))
QUIT
+7 SET (LA7CNT,LA7K)=0
+8 FOR
SET LA7K=$ORDER(^LAH(LA7I,1,"AUTOREL-UID",LA7K))
if LA7K=""
QUIT
SET LA7CNT=LA7CNT+1
+9 SET LA7J=LA7J+1
SET LA7J(LA7J)=LA7I
SET DIR("A",LA7J)=LA7J_" "_$PIECE(^LRO(68.2,LA7I,0),"^")_" (Queue size: "_LA7CNT_" accession"_$SELECT(LA7CNT>1:"s",1:"")_")"
End DoDot:1
+10 IF '$ORDER(LA7J(0))
QUIT
+11 ;
+12 WRITE !!
+13 SET DIR(0)="LO^1:"_LA7J
+14 SET DIR("A")="Select the number(s) of the LOAD/WORK LIST Auto Release to restart"
+15 SET DIR("A",.1)="The following Load Lists have results in the Auto Release queue:"
SET DIR("A",.2)=" "
SET DIR("A",LA7J+1)=" "
+16 DO ^DIR
+17 IF $DATA(DIRUT)
QUIT
+18 ;
+19 FOR LA7I=1:1
SET LA7J=$PIECE(Y,",",LA7I)
if LA7J<1
QUIT
SET LRLL(LA7J(LA7J))=""
+20 ;
+21 SET LWL=0
+22 FOR
SET LWL=$ORDER(LRLL(LWL))
if 'LWL
QUIT
Begin DoDot:1
+23 SET LA7X=$PIECE(^LRO(68.2,LWL,0),"^")
+24 DO QLAH^LA7VIN(LWL,"EN^LRVRAR")
+25 DO EN^DDIOL("Queued auto release processing for LOAD/WORK LIST "_LA7X,"","!")
End DoDot:1
+26 QUIT
+27 ;
+28 ;
DICS(DA) ; Perform FileMan DIC screen on lookup
+1 ; Call with DA = IEN of entry in file #62.49
+2 ; Returns LA7Y = 1 if entry should be selected
+3 ; = 0 if not selectable
+4 ; Entry should be type (I)ncoming, have a status of (X)purgable, (E)rror or (Q)ueued for processing and
+5 ; be related to an message configuration type 1-UI or 10-LEDI.
+6 ; Messages for other configuration types should not be reprocessed at this time.
+7 NEW LA7I,LA7X,LA7Y
+8 SET LA7I(0)=$GET(^LAHM(62.49,DA,0))
SET LA7Y=0
+9 IF $PIECE(LA7I(0),"^",2)="I"
IF $PIECE(LA7I(0),"^",3)?1(1"X",1"E",1"Q")
Begin DoDot:1
+10 SET LA7X=$PIECE($GET(^LAHM(62.49,DA,.5)),"^")
SET LA7X(0)=$GET(^LAHM(62.48,LA7X,0))
+11 IF $PIECE(LA7X(0),"^",9)>0
IF $PIECE(LA7X(0),"^",9)<11
SET LA7Y=1
End DoDot:1
+12 QUIT LA7Y
