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

LRVRARU.m

Go to the documentation of this file. 
  1. LRVRARU ;DALOI/STAFF - AUTO RELEASE UTILITY PROGRAM ;04/05/16  11:02
  1.  ;;5.2;LAB SERVICE;**458**;Sep 27, 1994;Build 10
  1.  ;
  1.  ; Reference to DUZ^XUP supported by DBIA #4129
  1.  ; Reference to DIVSET^XUSRB2 supported by DBIA #4055
  1.  ;
  1.  ; ZEXCEPT is used to identify variables which are external to a specific TAG
  1.  ;         used in conjunction with Eclipse M-editor.
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. INIT ; Initialize user/environment
  1.  ;
  1.  ;ZEXCEPT: DIQUIET,LAMSG,LRAA,LRALERT,LRANYAA,LRAUTORELEASE,LRAUTOVERIFY,LRCDEF,LRCNT,LRDELTACHKOK,LRDFWKLD,LRDUZ
  1.  ;ZEXCEPT: LREND,LRERR,LRIEN,LRLABKY,LRLD,LRLL,LRNOECHO,LRORDNLT,LROUTINE,LRPARAM,LRPROF,LRQUIET,LRSTORE,LRVBY,VAERR
  1.  ;ZEXCEPT: ZTREQ
  1.  ;
  1.  N I,LR60,LR61,LR62,LR64,LR0070,LRNLT,LRX,LRY
  1.  ;
  1.  ; If rollover has not completed then requeue task 5 minutes in future and send alert.
  1.  I +$G(^LAB(69.9,1,"RO"))'=(+$H) D  Q
  1.  . S ZTREQ=$$HADD^XLFDT($H,0,0,5,0)
  1.  . S LAMSG="AR: Lab Rollover has not completed as of "_$$HTE^XLFDT($H,"1M")
  1.  . S LREND=1
  1.  ;
  1.  I '$D(^LRO(68.2,LRLL,0))#2 D  Q
  1.  . S LREND=1
  1.  . S LAMSG="AR: No Entry for Load/Work List using IEN: "_LRLL
  1.  ;
  1.  S LRLL(0)=^LRO(68.2,LRLL,0)
  1.  S (LRAUTOVERIFY,LRCNT,LRDELTACHKOK,LREND,LRSTORE)=0,(DIQUIET,LRAUTORELEASE,LRNOECHO,LRQUIET)=1,LAMSG=""
  1.  ;
  1.  K LRDUZ,LRERR,LRIEN,LRORDNLT
  1.  D KVAR^VADPT
  1.  ;
  1.  ; DUZ = set to IEN of LRLAB,AUTO RELEASE application proxy
  1.  S LRX=$$FIND1^DIC(200,"","OX","LRLAB,AUTO RELEASE","B","")
  1.  I LRX<1 D  Q
  1.  . S LREND=1
  1.  . S LAMSG="AR: Unable to identify proxy 'LRLAB,AUTO RELEASE' in NEW PERSON file"
  1.  D DUZ^XUP(LRX)
  1.  S LRDUZ("AR")=LRX
  1.  ;
  1.  ; LRDUZ("AR") = set to IEN of LRLAB,AUTO VERIFY application proxy
  1.  S LRX=$$FIND1^DIC(200,"","OX","LRLAB,AUTO VERIFY","B","")
  1.  I LRX<1 D  Q
  1.  . S LREND=1
  1.  . S LAMSG="AR: Unable to identify proxy 'LRLAB,AUTO VERIFY' in NEW PERSON file"
  1.  S LRDUZ("AV")=LRX
  1.  ;
  1.  ;Initialize LRDUZ("USER"), used to hold the user's DUZ when user verified on external system
  1.  S LRDUZ("USER")=""
  1.  ;
  1.  D EN^LRPARAM
  1.  I $G(LREND) S LAMSG="AR: LRPARAM Error for Load/Work List "_$P(LRLL(0),"^") Q
  1.  S $P(LRPARAM,U,3)="",$P(LRPARAM,U,4)=""
  1.  S LRLABKY="1^^^1" ;lab verification keys
  1.  ;
  1.  ; Use first profile designated for auto release on this load list.
  1.  S LRPROF=$O(^LRO(68.2,LRLL,10,"AR",1,0))
  1.  I 'LRPROF D  Q
  1.  . S LREND=1
  1.  . S LAMSG="AR: No Auto Release Profile for Load/Work List "_$P(LRLL(0),"^")
  1.  ;
  1.  S LRPROF(0)=^LRO(68.2,LRLL,10,LRPROF,0)
  1.  S LRAA=$P(LRPROF(0),U,2)
  1.  I $P(^LRO(68,LRAA,0),U,2)'="CH" S LREND=1,LAMSG="AR: No CH accession area for Load/Work List "_$P(LRLL(0),"^") Q
  1.  S LRANYAA=+$P(LRPROF(0),"^",3)
  1.  ;
  1.  ; Use default reference lab field as performing and releasing lab
  1.  S LRDUZ(2)=+$P(LRPROF(0),"^",5)
  1.  I LRDUZ(2)'=DUZ(2) D  Q:LREND
  1.  . S LRY=0
  1.  . I LRDUZ(2)>0 D DIVSET^XUSRB2(.LRY,"`"_LRDUZ(2))
  1.  . I LRY Q
  1.  . S LREND=1,LAMSG="AR: Unable to set user 'LRLAB,AUTO RELEASE' to division "_$S(LRDUZ(2)<1:"<none specified>",1:$$GET1^DIQ(4,LRDUZ(2)_",",.01))_" on profile: "_$P(LRPROF(0),U)
  1.  ;
  1.  S LRX=$G(^LRO(68,LRAA,0))
  1.  S LRLD=$S($P(LRX,U,19)'="":$P(LRX,U,19),1:"CP")
  1.  ;
  1.  S LRDFWKLD=+$G(^LRO(68.2,LRLL,"SUF"))
  1.  D WKLD(LRDFWKLD)
  1.  I LRCDEF="" D  Q
  1.  . S LREND=1
  1.  . S LAMSG="AR: No Default Suffix for Load/Work List "_$P(LRLL(0),"^")
  1.  ;
  1.  ; Explode the test list
  1.  K ^TMP("LR",$J)
  1.  D EXPLODE^LRGP2
  1.  I '$O(^TMP("LR",$J,"VTO",0)) D  Q
  1.  . S LREND=1
  1.  . S LAMSG="AR: No Test defined for Load/Work List "_$P(LRLL(0),"^")_" using profile: "_$P(LRPROF(0),U)
  1.  ;
  1.  K LRIEN,LRERR
  1.  S (LRERR,VAERR)=0
  1.  S LROUTINE=$$GET1^DIQ(69.9,"1,",301,"I","ANS","ERR") ;Routine urgency
  1.  S:'LROUTINE LROUTINE=9
  1.  S LRALERT=LROUTINE
  1.  ;
  1.  S LRVBY=2
  1.  Q
  1.  ;
  1.  ;
  1. WKLD(LRP) ; Setup LRCDEF* variables for workload
  1.  ; Call with LRP = ien of WKLD suffix in file #64.2
  1.  ;
  1.  ;ZEXCEPT: LRCDEF,LRCDEF0
  1.  ;
  1.  S LRCDEF0=$G(^LAB(64.2,LRP,0)),LRCDEF0(1)=$P(LRCDEF0,"^",19)
  1.  S LRCDEF=$P($P(LRCDEF0,"^",2),".",2)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. WKLDC(LRLL,LRAA) ; Setup LRCAP*, LRCS*, LRSUF* variables for workload
  1.  ; Call with LRLL = ien of load/workk list in file #62.8
  1.  ;           LRAA = ien of accession area in file #68
  1.  ;
  1.  ;ZEXCEPT: LRCAPMS,LRCAPWA,LRCSQ,LRCSQQ,LRPARAM,LRSUF0,LRUSUFO
  1.  ;
  1.  N LREND,Y
  1.  ;
  1.  ; Cleanup values from processing a previous accession as area could be different.
  1.  K LRCAPMS,LRCAPWA,LRCSQ,LRCSQQ,LRSUF0,LRUSUFO
  1.  ;
  1.  ; Check if workload turned on.
  1.  I '$P(LRPARAM,U,14)!('$G(LRAA)) Q
  1.  I '$P($G(^LRO(68,+LRAA,0)),U,16) Q
  1.  ;
  1.  ; Setup worload code variables for this accession area
  1.  S Y=LRLL D EN1^LRCAPV
  1.  ;
  1.  ; Override file setting, do not prompt for COLLECT STD/QC/REPEATS (#11) (nobody to answer).
  1.  S LRCSQQ=0
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SPALERT ; Send Processing Alert Message
  1.  ;
  1.  ;ZEXCEPT: LRLL,LRSTORE
  1.  ;
  1.  N LAMSG,LRTIME,LRX
  1.  S LRX=0,LRTIME=$$HTE^XLFDT($H,"1M")
  1.  F  S LRX=$O(LRSTORE(LRX)) Q:'LRX  D
  1.  . I '$D(^LAHM(62.48,LRX,20,"B",1)) Q  ; New result alerts not defined
  1.  . S LAMSG=$P(LRSTORE(LRX),"^")_" Patient(s) processed for Auto Release: "_$P(LRLL(0),"^")_" on "_LRTIME
  1.  . D XQA^LA7UXQA(1,LRX,"","",LAMSG,"",1)
  1.  Q
  1.  ;
  1.  ;
  1. SENDACK ; Send HL7 ACKnowledgment message
  1.  ;
  1.  ;ZEXCEPT: LA7624,LA76248,LA76249,LA7AAT,LRERR,LRUID,PNM,SSN
  1.  ;
  1.  N LA
  1.  ;
  1.  I LA7AAT(1)=""!(LA7AAT(1)="NE") Q
  1.  I LA7AAT(1)="SU",$G(LRERR)'="" Q
  1.  I LA7AAT(1)="ER",$G(LRERR)="" Q
  1.  ;
  1.  S LA(62.4)=LA7624,LA(62.48)=LA76248,LA(62.49)=LA76249
  1.  S LA("ACK")=$S(+LRERR:"AE",1:"AA")
  1.  S LA("ID",1)=LRUID
  1.  S LA("ID",2)=PNM
  1.  S LA("ID",3)=SSN
  1.  S LA("MSG")=$P(LRERR,"^",2)
  1.  I $L(LA("MSG"))>80 S LA("MSG")=$E(LA("MSG"),1,80),LA("MSG")=$P(LA("MSG"),". ") ; HL7 specifies field length 80.
  1.  ;
  1.  ; Build info for ERR segment
  1.  D BLDERR^LA7VHLU8(.LA,LRERR)
  1.  ;
  1.  D ACK^LA7VHLU8(.LA)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CLEAN ;Clean-up point
  1.  ;
  1.  ;ZEXCEPT: AGE,COMB,CONTROL,DFN,DOB,DTS,H8,I5,LRACC,LRACD,LRAD,LRAN,LRAOD,LRASSN,LRBLBP,LRCAPLOC,LRCDEF,LRCDEF0,LRCDEF0X,LRCDT
  1.  ;ZEXCEPT: LRCODEN,LRCOM,LRDATA,LRERR,LRIDT,LRIN,LRIX,LRM,LRNLT,LRNOCODE,LRNOW,LRNT,LRNX,LRODT,LRODTIM,LROLDIV,LROLLOC,LRORD
  1.  ;ZEXCEPT: LRORU3,LROT,LRPRAC,LRRB,LRSB,LRSN,LRSSCX,LRSSN,LRST,LRSUB,LRSUM,LRSXN,LRT,LRTN,LRTREA,LRTS,LRTSORU,LRTST,LRTT,LRUID
  1.  ;ZEXCEPT: LRUNQ,LRWRD,OCXAP,PNM,S5,SEGID,SEX,SSN,T1,VA,VADMVT,VAINDT,VAL,XP,Z
  1.  ;
  1.  D KVAR^VADPT
  1.  K AGE,COMB,CONTROL,DFN,DOB,DTS,H8,I5
  1.  K LRACC,LRACD,LRAD,LRAN,LRAOD
  1.  K LRASSN,LRCAPLOC,LRCDT,LRCDEF,LRCDEF0,LRCDEF0X,LRCODEN,LRCOM
  1.  K LRDATA,LRERR,LRNOCODE,LROLDIV
  1.  K LRPRAC,LRRB
  1.  K LRSB,LRSN,LRSSCX,LRSSN,LRSUB,LRSXN,LRST,LRSUB,LRSUM
  1.  K LRSXN,LRT,LRTN,LRTREA,LRTS,LRTSORU,LRTST,LRTT,LRUID
  1.  K LRUNQ,LRWRD,PNM,S5,SEGID,SEX,SSN
  1.  K LRIDT,LRIN,LRIX,LRBLBP,LRM,LRNLT,LRNOW,LRNT,LRNX,LRODT
  1.  K LROLLOC,LRORD,LRODTIM,LRORU3,LROT,OCXAP
  1.  K T1,VA,VADMVT,VAINDT,VAL,XP,Z
  1.  Q