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

LA7UTILB.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EN ; Select a Lab HL7 message to reprocess.
  1.  N DIC,DIR,DIROUT,DIRUT,DTOUT,FDA,LA7DIE,LA76248,LA7I,LA7LIST,LA7X,PARAM,X,Y
  1.  ;
  1.  S PARAM("SHOIDS")=$$GET^XPAR("USR^SYS","LA7UTILA SHOIDS",1,"Q")
  1.  S PARAM("SHOIDS LAST")=$$GET^XPAR("USR^SYS","LA7UTILA SHOIDS LAST",1,"Q")
  1.  S X=PARAM("SHOIDS")
  1.  I X="L" S X=PARAM("SHOIDS LAST")
  1.  I X="" S X=PARAM("SHOIDS")
  1.  I X="" S X=1
  1.  I X'=+X S X=$S(X="Y":1,X="N":0,1:1)
  1.  K PARAM
  1.  S DIR("B")=$S(X:"YES",1:"NO")
  1.  S DIR(0)="Y",DIR("A")="Display identifiers during message selection"
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  I Y<1 S DIC("W")="D DICW^LA7UTILA"
  1.  ; save PARAM setting
  1.  D EN^XPAR("USR","LA7UTILA SHOIDS LAST",1,$S(+Y>0:1,1:0))
  1.  S DIC="^LAHM(62.49,",DIC("S")="I $$DICS^LA7UTILB(Y)"
  1.  S DIC(0)="EQMZ"
  1.  S X=$$SELECT^LRUTIL(.DIC,.LA7LIST,"Message",10,0,1,1)
  1.  ;
  1.  K DIC,DIR
  1.  ;
  1.  ; Confirm selection
  1.  I $O(LA7LIST(0)) D
  1.  . S DIR(0)="YO",DIR("A")="Reprocess these messages",DIR("B")="YES"
  1.  . D ^DIR
  1.  . I Y'=1 Q
  1.  . D SETSTAT,TASK
  1.  ;
  1.  I '$O(LA7LIST(0)) D CHECKQ
  1.  ;
  1.  ; Check if auto release master switch parameter is ON (1) then check for any queues needing restarting.
  1.  I $$GET^XPAR("SYS^PKG","LA UI AUTO RELEASE MASTER",1,"Q") D CHECKARQ
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SETSTAT ; Set status of selected messages to queued for processing
  1.  ;
  1.  ;ZEXCEPT: LA76248,LA7LIST
  1.  ;
  1.  N FDA,LA7I,LRDIE
  1.  S LA7I=0
  1.  F  S LA7I=$O(LA7LIST(LA7I)) Q:'LA7I  D
  1.  . K FDA,LRDIE
  1.  . S FDA(1,62.49,LA7I_",",2)="Q"
  1.  . D FILE^DIE("","FDA(1)","LA7DIE(1)")
  1.  . S LA76248=$P($G(^LAHM(62.49,LA7I,.5)),"^")
  1.  . I LA76248 S LA76248(LA76248)=""
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. TASK ; Task processing routine for each message's respective configuration
  1.  ;
  1.  ;ZEXCEPT: LA76248
  1.  ;
  1.  N LA7X
  1.  S LA76248=0
  1.  F  S LA76248=$O(LA76248(LA76248)) Q:'LA76248  D
  1.  . S LA7X=$P($G(^LAHM(62.48,LA76248,0)),"^")
  1.  . I $G(^LAHM(62.48,LA76248,1))'="" X ^(1) D EN^DDIOL("Queued processing routine for configuration "_LA7X,"","!") Q
  1.  . D EN^DDIOL($C(7)_"Unable to queue processing routine for configuration "_LA7X_" - No processing routine","","!")
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CHECKQ ; Check "IQ" incoming queued for processing queues in case need to restart.
  1.  N DIR,DIRUT,DTOUT,DUOUT,LA76248,LA7CNT,LA7I,LA7J,LA7K,X,Y
  1.  S (LA7I,LA7J)=0
  1.  F  S LA7I=$O(^LAHM(62.48,LA7I)) Q:LA7I<1  D
  1.  . I '$P(^LAHM(62.48,LA7I,0),"^",3) Q
  1.  . I '$D(^LAHM(62.49,"Q",LA7I,"IQ")) Q
  1.  . S (LA7CNT,LA7K)=0
  1.  . F  S LA7K=$O(^LAHM(62.49,"Q",LA7I,"IQ",LA7K)) Q:LA7K<1  S LA7CNT=LA7CNT+1
  1.  . S LA7J=LA7J+1,LA7J(LA7J)=LA7I,DIR("A",LA7J)=LA7J_"  "_$P(^LAHM(62.48,LA7I,0),"^")_" (Queue size: "_LA7CNT_")"
  1.  I '$O(LA7J(0)) Q
  1.  W !!
  1.  S DIR(0)="LO^1:"_LA7J
  1.  S DIR("A")="Select the number(s) of the configurations to restart"
  1.  S DIR("A",.1)="The following configurations have messages queued for processing:",DIR("A",.2)=" ",DIR("A",LA7J+1)=" "
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  S LA7I=0
  1.  F LA7I=1:1 S LA7J=$P(Y,",",LA7I) Q:LA7J<1  S LA76248(LA7J(LA7J))=""
  1.  I $D(LA76248) D TASK
  1.  Q
  1.  ;
  1.  ;
  1. CHECKARQ ; Check LAH global for pending auto release results in case need to restart
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,LA7CNT,LA7I,LA7J,LA7K,LA7X,LRLL,LWL,X,Y
  1.  ;
  1.  S (LA7I,LA7J)=0
  1.  F  S LA7I=$O(^LAH(LA7I)) Q:LA7I<1  D
  1.  . I '$D(^LAH(LA7I,1,"AUTOREL-UID")) Q
  1.  . S (LA7CNT,LA7K)=0
  1.  . F  S LA7K=$O(^LAH(LA7I,1,"AUTOREL-UID",LA7K)) Q:LA7K=""  S LA7CNT=LA7CNT+1
  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:"")_")"
  1.  I '$O(LA7J(0)) Q
  1.  ;
  1.  W !!
  1.  S DIR(0)="LO^1:"_LA7J
  1.  S DIR("A")="Select the number(s) of the LOAD/WORK LIST Auto Release to restart"
  1.  S DIR("A",.1)="The following Load Lists have results in the Auto Release queue:",DIR("A",.2)=" ",DIR("A",LA7J+1)=" "
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  ;
  1.  F LA7I=1:1 S LA7J=$P(Y,",",LA7I) Q:LA7J<1  S LRLL(LA7J(LA7J))=""
  1.  ;
  1.  S LWL=0
  1.  F  S LWL=$O(LRLL(LWL)) Q:'LWL  D
  1.  . S LA7X=$P(^LRO(68.2,LWL,0),"^")
  1.  . D QLAH^LA7VIN(LWL,"EN^LRVRAR")
  1.  . D EN^DDIOL("Queued auto release processing for LOAD/WORK LIST "_LA7X,"","!")
  1.  Q
  1.  ;
  1.  ;
  1. DICS(DA) ; Perform FileMan DIC screen on lookup
  1.  ; Call with DA = IEN of entry in file #62.49
  1.  ; Returns LA7Y = 1 if entry should be selected
  1.  ;              = 0 if not selectable
  1.  ; Entry should be type (I)ncoming, have a status of (X)purgable, (E)rror or (Q)ueued for processing and
  1.  ; be related to an message configuration type 1-UI or 10-LEDI.
  1.  ; Messages for other configuration types should not be reprocessed at this time.
  1.  N LA7I,LA7X,LA7Y
  1.  S LA7I(0)=$G(^LAHM(62.49,DA,0)),LA7Y=0
  1.  I $P(LA7I(0),"^",2)="I",$P(LA7I(0),"^",3)?1(1"X",1"E",1"Q") D
  1.  . S LA7X=$P($G(^LAHM(62.49,DA,.5)),"^"),LA7X(0)=$G(^LAHM(62.48,LA7X,0))
  1.  . I $P(LA7X(0),"^",9)>0,$P(LA7X(0),"^",9)<11 S LA7Y=1
  1.  Q LA7Y