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

LA7HDR1.m

Go to the documentation of this file. 
  1. LA7HDR1 ;DALOI/JMC - LAB HDR ORU (Observation Result) message builder (cont'd) ;July 28, 2008
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**68**;Sep 27, 1994;Build 56
  1.  ;
  1.  ; Reference to variable DIQUIET supported by DBIA #2098
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. HDRLOAD ; Load patient's historical lab results to HDR (Health Data Repository).
  1.  ; Called from tasked option LA7TASK HDR LOAD
  1.  N DIQUIET,GBL
  1.  N LA7101,LA761,LA76248,LA76249,LA76249P
  1.  N LA7CODE,LA7CNT,LA7DT,LA7ECH,LA7ERR,LA7FS,LA7ID,LA7INTYP,LA7MID,LA7MTYP,LA7NOMSG,LA7NTESN,LA7NVAF,LA7OBRSN,LA7OBXSN,LA7PIDSN,LA7RSITE,LA7QUIT,LA7SC,LA7SPEC
  1.  N LRDFN,LRIDT,LRSS,LRSSLST,LRUID,SITE
  1.  ;
  1.  ; Prevent FileMan from issuing any unwanted WRITE(s).
  1.  S DIQUIET=1,DT=$$DT^XLFDT
  1.  ;
  1.  ; Find entry in #62.48 and check if it's active.
  1.  S (LA7RSITE,SITE)="LA7HDR",LA76248=$O(^LAHM(62.48,"B",LA7RSITE,0))
  1.  ; No entry in 62.48 - *** Need to add error logging ****
  1.  I 'LA76248 Q
  1.  I '$P(^LAHM(62.48,LA76248,0),"^",3) Q  ; not active
  1.  S LA7INTYP=+$P(^LAHM(62.48,LA76248,0),"^",9)
  1.  ;
  1.  S (LA7CNT,LA7CNT(1),LA7ERR,LA7NVAF,LA7QUIT)=0,LA7MTYP="ORU",LA7NOMSG=2
  1.  I LA7EVENT="" S LA7EVNT="LA7 LAB RESULTS AVAILABLE (EVN)"
  1.  ; Setup search and subscript list
  1.  S (LA7SC,LA7SPEC)="*"
  1.  D SCLIST^LA7QRY2(LA7SC,.LRSSLST)
  1.  ; Check start/end dates
  1.  I '$G(LA7SDT) S LA7SDT=$$FMADD^XLFDT(DT,-730,0,0,0)
  1.  I '$G(LA7EDT) S LA7EDT=DT
  1.  I LA7SDT>LA7EDT S X=LA7SDT,LA7SDT=LA7EDT,LA7EDT=X
  1.  ;
  1.  S GBL="^TMP(""HLS"","_$J_")"
  1.  ; Limit number of messages built this session.
  1.  S LA7LIMIT=$G(LA7LIMIT,1000)
  1.  ;
  1.  I $D(^XTMP("LA7HDR","LRDFN")) S LRDFN=$P(^XTMP("LA7HDR","LRDFN"),"^")
  1.  E  S LRDFN=0
  1.  I LRDFN'=+LRDFN Q
  1.  F  S LRDFN=$O(^LR(LRDFN)) Q:'LRDFN  D  Q:LA7QUIT
  1.  . I $$S^%ZTLOAD("Processing LRDFN "_LRDFN_" for HDR Historical") S (LA7QUIT,ZTSTOP)=1,LRDFN=LRDFN-1 Q
  1.  . S LA7CNT(1)=LA7CNT(1)+1
  1.  . I '(LA7CNT(1)#100) H 1 ; take a "rest" - allow OS to swap out process
  1.  . S X=^LR(LRDFN,0) Q:$P(X,"^",2)'=2
  1.  . S DFN=$P(X,"^",3),LA7ID=SITE_"-O-"_$$GET1^DIQ(2,DFN_",",.01)
  1.  . K ^TMP("LA7-QRY",$J),^TMP("LA7VS",$J)
  1.  . D BCD^LA7QRY2 S LA7QUIT=0 Q:'$D(^TMP("LA7-QRY",$J))
  1.  . S LA76249=$$INIT6249^LA7VHLU,^TMP("LA7VS",$J,LA76249)=LA76249
  1.  . D INITHL^LA7VHLU(LA7EVNT)
  1.  . I $G(HL) S LA7QUIT=1,LRDFN=LRDFN-1 Q
  1.  . D BUILDMSG^LA7QRY1,GEN^LA7VHLU,UPDT6249^LA7VORM1
  1.  . S LA7CNT=LA7CNT+1,LA7QUIT=$S(LA7CNT<LA7LIMIT:0,1:1)
  1.  ;
  1.  ; Update XTMP entry, save last LRDFN processed for next session.
  1.  S ^XTMP("LA7HDR",0)=$$FMADD^XLFDT(DT,90,0,0,0)_"^"_DT_"^Lab historical results feed to HDR"
  1.  S ^XTMP("LA7HDR","LRDFN")=LRDFN
  1.  ;
  1.  D EXIT
  1.  Q
  1.  ;
  1.  ;
  1. RECOVER ; Recover failed transmissions or message building
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,FIRST,LA76248,LA7CNT,LA7PROD,LA7QUIT,LA7TYPE,LA7UID,LA7X,LA7Y,LAST,LRAA,LRACC,LRAD,LRAN,LRDFN,LREXMPT,LRIDT,LRSPEC,LRSS,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  S (LA7CNT,LA7QUIT)=0
  1.  ;
  1.  S LA76248=$O(^LAHM(62.48,"B","LA7HDR",0))
  1.  I 'LA76248 W !,"No entry LA7HDR in file #62.48" Q
  1.  I '$P(^LAHM(62.48,LA76248,0),"^",3) D  Q
  1.  . S DIR(0)="EA"
  1.  . S DIR("A")="Enter RETURN to continue:"
  1.  . S DIR("A",1)="Entry LA7HDR is not active in file #62.48"
  1.  . D ^DIR
  1.  ;
  1.  S LA7PROD=$$PROD^XUPROD(0)
  1.  ;
  1.  S DIR(0)="SO^1:Range of Accessions;2:Selected Accessions"
  1.  S DIR("A")="Selection Method",DIR("B")=1
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  S LA7TYPE=+Y
  1.  ;
  1.  ; Get list of accession numbers, set flags used by LRWU4.
  1.  S LRACC=1,LREXMPT=1
  1.  I LA7TYPE=1 D
  1.  . D ^LRWU4
  1.  . I LRAN<1 S LA7QUIT=1 Q
  1.  . S FIRST=LRAN,X=$O(^LRO(68,LRAA,1,LRAD,1,":"),-1)
  1.  . S DIR(0)="NO^"_LRAN_":"_X_":0",DIR("B")=LRAN
  1.  . S DIR("A",1)="",DIR("A")="Recover accessions from "_LRAN_" to"
  1.  . D ^DIR K DIR
  1.  . I $D(DIRUT) S LA7QUIT=1 Q
  1.  . S LRAN=FIRST-1,LAST=Y
  1.  . F  S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:'LRAN!(LRAN>LAST)  D SETTMP
  1.  I LA7TYPE=2 F  D  Q:LA7QUIT!(LRAN<1)
  1.  . D ^LRWU4
  1.  . I $D(DTOUT)!($D(DUOUT)) S LA7QUIT=1 Q
  1.  . I LRAN<1 S:'$D(^TMP("LA7S-RTM",$J)) LA7QUIT=1 Q
  1.  . D SETTMP
  1.  I LA7QUIT Q
  1.  ;
  1.  I '$D(^TMP("LA7S-RTM",$J)) D  Q
  1.  . S DIR("A",1)="No accessions found to retransmit."
  1.  . S DIR("A")="Enter RETURN to continue or '^' to exit"
  1.  . S DIR(0)="E"
  1.  . D ^DIR
  1.  ;
  1.  S DIR("A")="Ready to retransmit"
  1.  S DIR("A",1)="Found "_LA7CNT_" accessions that can be retransmitted."
  1.  S DIR(0)="YO",DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  I Y'=1 K ^TMP("LA7S-RTM",$J) Q
  1.  D EN^DDIOL("Working","","!")
  1.  ;
  1.  K LA7Y
  1.  S LA7CNT=0,LA7UID=""
  1.  F  S LA7UID=$O(^TMP("LA7S-RTM",$J,LA7UID)) Q:LA7UID=""  D
  1.  . K LA7X,ZTSAVE
  1.  . S LA7X=^TMP("LA7S-RTM",$J,LA7UID),LA7CNT=LA7CNT+1
  1.  . S ZTRTN="BUILD^LA7HDR",ZTDTH=$H,ZTIO="",ZTDESC="Tasked Lab HL7 HDR ORU Build"
  1.  . S ZTSAVE("LRAA")=$P(LA7X,"^"),ZTSAVE("LRAD")=$P(LA7X,"^",2),ZTSAVE("LRAN")=$P(LA7X,"^",3)
  1.  . S ZTSAVE("LRDFN")=$P(LA7X,"^",4),ZTSAVE("LRSS")=$P(LA7X,"^",5),ZTSAVE("LRIDT")=$P(LA7X,"^",6),ZTSAVE("LA7MTYP")="ORU"
  1.  . I $P(LA7X,"^",5)="CH" S ZTSAVE("LRSPEC")=$P(LA7X,"^",7)
  1.  . D ^%ZTLOAD
  1.  . I $G(ZTSK) D
  1.  . . I LA7CNT>101 Q
  1.  . . I LA7CNT=101 S LA7Y(101)="*** Too many accessions to list (>100), list truncated... ***" Q
  1.  . . S LA7Y(LA7CNT)="Task# "_ZTSK_" queued for processing accession "_LA7UID
  1.  . E  S LA7Y(LA7CNT)="*** Tasking of retransmission failed for accession "_LA7UID_" ***"
  1.  S LA7Y(.1)="...Done",LA7X(1,"F")=""
  1.  S LA7Y(.2)=LA7CNT_" accession"_$S(LA7CNT>1:"s",1:"")_" scheduled for retransmitting of results!"
  1.  D EN^DDIOL(.LA7Y)
  1.  K ^TMP("LA7S-RTM",$J)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SETTMP ;
  1.  ;
  1.  S LA7UID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^")
  1.  I LA7UID="" Q
  1.  S LRDFN=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^")
  1.  ; Quit if not a file #2 patient.
  1.  I $P($G(^LR(LRDFN,0)),"^",2)'=2 Q
  1.  ; Quit if test patient on a production account.
  1.  I $$TESTPAT^VADPT($P($G(^LR(LRDFN,0)),"^",3)),LA7PROD Q
  1.  S LRSS=$P($G(^LRO(68,LRAA,0)),"^",2),LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5)
  1.  I LRSS?1(1"CH",1"MI") S LRSPEC=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1)),"^")
  1.  E  S LRSPEC=""
  1.  S LA7CNT=LA7CNT+1,^TMP("LA7S-RTM",$J,LA7UID)=LRAA_"^"_LRAD_"^"_LRAN_"^"_LRDFN_"^"_LRSS_"^"_LRIDT_"^"_LRSPEC
  1.  Q
  1.  ;
  1.  ;
  1. EXIT ;
  1.  K LA7LIMIT
  1.  D CLEANUP^LA7QRY,EXIT^LA7VORM1
  1.  K @GBL,^TMP("LA7VS",$J)
  1.  Q