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

LRVRMI4.m

Go to the documentation of this file. 
  1. LRVRMI4 ;DALOI/STAFF - LAH/TMP TO FILE 63 ;09/07/16  08:09
  1.  ;;5.2;LAB SERVICE;**350,427,474**;Sep 27, 1994;Build 14
  1.  ;
  1.  ; Extracts the information in the ^TMP("LRMI",$J) global and stores it into the Lab Data micro subfile.
  1.  ;
  1.  Q
  1.  ;
  1. EN ;
  1.  N LRNODE,LRNOW,LRRPTAPP,LRSTATUS,LR63539,X,I
  1.  Q:'$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT))
  1.  S LRNOW=$$NOW^XLFDT
  1.  ; Get IEN of last Micro Audit on file
  1.  S LR63539=0
  1.  S X=$O(^LR(LRDFN,"MI",LRIDT,32,"B","A"),-1)
  1.  I X S LR63539=$O(^LR(LRDFN,"MI",LRIDT,32,"B",X,0))
  1.  ;
  1.  ; If any of these nodes are defined then trigger the audit
  1.  F I=1,2,3,4,5,6,7,8,9,10,11,12,13,15,16,17,18,99 I $D(^LR(LRDFN,"MI",LRIDT,I)) D  Q
  1.  . I $G(LRSB)'>0 N LRSB S LRSB=$S(I<5:1,I<8:5,I<11:8,I<14:11,I<19:16,I=99:.99,1:0)
  1.  . I LRSB>0 D AUDTRG
  1.  ;
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,0)) D N2
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,0)) D N3^LRVRMI4A
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,0)) D N4
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,0)) D N6^LRVRMI4A
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,0)) D N7^LRVRMI2
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,0)) D N9^LRVRMI2A
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,0)) D N10^LRVRMI2
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11)) D N11^LRVRMI2A
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,0)) D N12^LRVRMI2A
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,0)) D N13^LRVRMI2
  1.  ;I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,0)) D N15^LRVRMI2
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,0)) D N17^LRVRMI2A
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,0)) D N18^LRVRMI2
  1.  ;
  1.  F LRNODE=15,19:1:31 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,0)) D NODE^LRVRMI3(LRNODE)
  1.  ;
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99)) D N99
  1.  ;
  1.  ; Only release report when receving verified report from external lab (LEDI interface)
  1.  I LRINTYPE=10 D
  1.  . D SETSTAT^LRVRMI4A(.LRSTATUS)
  1.  . I (LRSTATUS(0)="C")!(LRSTATUS(0)="F") D FIN  ; ccr_5439n - Added IF statement to only Do FIN if overall status is final or corrected. LMT 9/6/11
  1.  ;
  1.  I $G(LRRPTAPP) D VT1^LRMIUT1
  1.  ;
  1.  ; Update MICRO AUDIT to reflect corrected status on verified reference lab reports (interface type 10 in file #62.48)
  1.  ;  If audit doesn't exist then create instead of updating.
  1.  I LRINTYPE=10,LRSTATUS(0)="C" D
  1.  . I LR63539<1 D AUDTRG Q
  1.  . N LRFDA,LRIEN,LRMSG,DIERR
  1.  . S LRIEN=LR63539_","_LRIDT_","_LRDFN_","
  1.  . S LRFDA(1,63.539,LRIEN,3)=3 ; Edit Type
  1.  . D FILE^DIE("","LRFDA(1)","LRMSG")
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. FIN ; Release report
  1.  N LRFDA,LRIEN,LRMSG,DIERR
  1.  S LRIEN=LRIDT_","_LRDFN_","
  1.  S LRFDA(1,63.05,LRIEN,.04)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1.  S LRFDA(1,63.05,LRIEN,.03)=LRNOW
  1.  ;S LRFDA(1,63.05,LRIEN,.2)=LRNOW ; ccr_5439n - Commented this line out as there is no field .2 in subfile #63.05. LMT 9/6/11
  1.  D FILE^DIE("","LRFDA(1)","LRMSG")
  1.  Q
  1.  ;
  1.  ;
  1. N2 ; Process gram stain comments
  1.  N DIERR,IEN,LRCMT,LRCSR,LRDATA,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
  1.  ;
  1.  M LRCMT=^LR(LRDFN,"MI",LRIDT,2)
  1.  ;
  1.  S IEN=0,STAT=""
  1.  F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,IEN)) Q:IEN<1  D
  1.  . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
  1.  . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
  1.  . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
  1.  . S LRFDA(2,63.29,LRIEN,.01)=LRX
  1.  . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,IEN,0,0)
  1.  . I $P(LRX,"^") S LRPL(IEN)=$P(LRX,"^")
  1.  . I $P(LRX,"^",3) S LRCSR(IEN,2,"LN")=$P(LRX,"^",3)
  1.  . I $P(LRX,"^",4) S LRCSR(IEN,2,"NLT")=$P(LRX,"^",4)
  1.  . I $P(LRX,"^",5)'="" D BLDSTAT^LRVRMI4A(63.05,11.5,$P(LRX,"^",5),.LRSTATUS)
  1.  I '$D(LRFDA) Q
  1.  ;
  1.  D UPDATE^DIE("","LRFDA(2)","LRFDAIEN","LRMSG")
  1.  ; Store performing lab
  1.  S IEN=0
  1.  F  S IEN=$O(LRPL(IEN)) Q:'IEN  D
  1.  . I $G(LRPL(IEN)),$G(LRFDAIEN(IEN)) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",2,"_LRFDAIEN(IEN),LRPL(IEN))
  1.  ;
  1.  ; Store code system references
  1.  I $D(LRCSR) D CSR(.LRCSR,.LRFDAIEN,LRDFN_",MI,"_LRIDT_",2,")
  1.  ;
  1.  K LRFDA,LRIENS,LRMSG,DIERR
  1.  S LRIEN=LRIDT_","_LRDFN_","
  1.  I LRINTYPE=10 S LRFDA(2,63.05,LRIEN,11)=LRNOW
  1.  S LRFDA(2,63.05,LRIEN,11.55)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1.  D FILE^DIE("","LRFDA(2)","LRMSG")
  1.  S LRRPTAPP=1
  1.  Q
  1.  ;
  1.  ;
  1. N4 ; Bact report remarks
  1.  N DIERR,IEN,LRCMT,LRCSR,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,0))
  1.  D BLDSTAT^LRVRMI4A(63.05,11.5,$P(LRX,"^",4),.LRSTATUS)
  1.  S LRPL=$P(LRX,"^")
  1.  M LRCMT=^LR(LRDFN,"MI",LRIDT,4)
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,IEN)) Q:IEN<1  D  ;
  1.  . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
  1.  . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
  1.  . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
  1.  . S LRFDA(4,63.33,LRIEN,.01)=LRX
  1.  . I $P(LRX,"^",3) S LRCSR(IEN,2,"LN")=$P(LRX,"^",3)
  1.  . I $P(LRX,"^",4) S LRCSR(IEN,2,"NLT")=$P(LRX,"^",4)
  1.  I '$D(LRFDA) Q
  1.  ;
  1.  D UPDATE^DIE("","LRFDA(4)","LRFDAIEN","LRMSG")
  1.  ;
  1.  ; Store performing lab
  1.  S IEN=0
  1.  F  S IEN=$O(LRFDAIEN(IEN)) Q:'IEN  I LRPL D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",4,"_LRFDAIEN(IEN),LRPL)
  1.  ;
  1.  ; Store code system references
  1.  I $D(LRCSR) D CSR(.LRCSR,.LRFDAIEN,LRDFN_",MI,"_LRIDT_",4,")
  1.  ;
  1.  K LRFDA,LRIENS,LRMSG,DIERR
  1.  S LRIEN=LRIDT_","_LRDFN_","
  1.  I LRINTYPE=10 D
  1.  . S LRFDA(4,63.05,LRIEN,11)=LRNOW
  1.  . S LRFDA(4,63.05,LRIEN,11.5)=$P($G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,0)),U,4)
  1.  S LRFDA(4,63.05,LRIEN,11.55)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1.  D FILE^DIE("","LRFDA(4)","LRMSG")
  1.  S LRRPTAPP=1
  1.  Q
  1.  ;
  1.  ;
  1. N99 ; Comment on specimen
  1.  N LRDATA,LRFDA,LRMSG,LRX
  1.  S LRDATA=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99))
  1.  Q:$TR(LRDATA," ","")=""  ; don't file empty comments
  1.  ; Don't file same comment
  1.  I LRDATA=$G(^LR(LRDFN,"MI",LRIDT,99)) Q
  1.  S LRIEN=LRIDT_","_LRDFN_","
  1.  S LRFDA(99,63.05,LRIEN,.99)=LRDATA
  1.  D FILE^DIE("","LRFDA(99)","LRMSG")
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99,0))
  1.  I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",99",$P(LRX,"^"))
  1.  Q
  1.  ;
  1.  ;
  1. AUDTRG ; Trigger the audit trail
  1.  N LRDATA,LRMODE,LRBATCH
  1.  S LRMODE="LDSI",LRBATCH=1
  1.  S LRDATA(63.539,1)=LRNOW
  1.  S LRDATA(63.539,3)=$S($G(LRSTATUS(0))'="C":1,1:3)
  1.  I LRINTYPE=1 S LRDATA(63.539,4)="Update from lab automated instrument via HL7"
  1.  I LRINTYPE=10 S LRDATA(63.539,4)="Update from performing lab via HL7"
  1.  D LEDI^LRMIAUD(.LRDATA)
  1.  Q
  1.  ;
  1.  ;
  1. CSR(LRCSR,LRFDAIEN,LRREF) ; Store code system references
  1.  ; Call with LRCSR = array of ien/codes to store as references (pass by value)
  1.  ;        LRFDAIEN = FileMan array of entries added by DBA call (pass by value)
  1.  ;           LRREF = root of reference to build full reference to data
  1.  ;
  1.  N IEN,LRDATA,LRDATAREF,LRDFN,LRROOT,ROLE,TYPE
  1.  ;
  1.  S LRROOT="LRCSR",LRDFN=$P(LRREF,",")
  1.  F  S LRROOT=$Q(@LRROOT) Q:LRROOT=""  D
  1.  . S IEN=$QS(LRROOT,1),ROLE=$QS(LRROOT,2),TYPE=$QS(LRROOT,3)
  1.  . I '$G(LRFDAIEN(IEN)) Q
  1.  . S LRDATAREF=LRREF_LRFDAIEN(IEN)
  1.  . S LRDATA(.01)=LRDATAREF,LRDATA(.02)=ROLE,LRDATA(.03)=LRCSR(IEN,ROLE,TYPE),LRDATA(.04)=TYPE
  1.  . D SETREF^LRUCSR(LRDFN,LRDATAREF,.LRDATA,1)
  1.  Q