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

LRHYA.m

Go to the documentation of this file. 
  1. LRHYA ;DALOI/HOAK - HOWDY UTILITY-A ; 4/20/16 2:41pm
  1.  ;;5.2;LAB SERVICE;**405,446,457,467**;Sep 27, 1994;Build 3
  1.  ;
  1.  ;
  1. OLT ; This block looks in the Howdy site file for tests that will print
  1.  ; order labels WILL NOT accession the test.
  1.  ; order label tests
  1.  K LRNODONE
  1.  S LRHYHOK=0
  1.  S LRTSTS=0
  1.  S LRPLICK=1
  1.  F  S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0  D
  1.  .  S ^TMP("LRHYDY",$J,LRDFN,LR3DTN,LRTSTS)=""
  1.  .  K LRNPZZX
  1.  .  S LRIENZZ=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0))
  1.  .  S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
  1.  .  I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNODUP=1 S LRNOTST(LRTSTS)="" S LRNPZZX(LRORD,LR3SN,LRTSTS)="" QUIT
  1.  .  I $D(^LRHY(69.86,LRHYSITE,25,"B",LRTSTS)) S LRHYHOK=1 D
  1.  ..  S LROLT1(LR3DTN,LR3SN)=LRTSTS
  1.  ..  S LRNOTST(LRTSTS)=""
  1.  ..  D ^LRHYBLD ;print order labels
  1.  D DONE
  1.  QUIT
  1.  ;
  1. LTE ; This block looks in the Howdy site file for those test to exclude 
  1.  ; from accessioning by Howdy
  1.  ;
  1.  Q:'$G(LRCOL99)
  1.  K LRNODONE
  1.  K LRCCOM
  1.  ;  exclude lab test
  1.  ;
  1.  S LRIENZZ=0
  1.  S LRHYHOK=0
  1.  S LRTSTS=0
  1.  ;
  1.  S LRHYTOK=0
  1.  K LRNPZZX
  1.  K LRNODUP
  1.  F  S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0  S LRHYHOK=0 D
  1.  .  ;
  1.  .  S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
  1.  .  I $D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS)) S LRHYHOK=1 S LRHYT654=LRTSTS S LRNOTST(LRTSTS)="",LREXORD(LRORD)="" QUIT
  1.  .  K LRNPZZX
  1.  .  K LRCCOM
  1.  .  S LRCOL99=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,3)
  1.  .  ;
  1.  .  K LRNODONE
  1.  .  S LRIENZZ=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0))
  1.  .  I $P($G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0)),U,6)'="" QUIT
  1.  .  I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA" S LRNODONE=1,LRHYHOK=1 QUIT
  1.  .  I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA" QUIT
  1.  .  I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))'["CA" S LRHYTOK=LRTSTS
  1.  .  I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNODUP=1 QUIT
  1.  .  I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA" QUIT
  1.  .  ;
  1.  .  I $D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS)) S LRHYHOK=1 QUIT
  1.  .  I LR3DTN=DT I $D(^TMP("LRHYDY",$J,"DUPTEST",LRTSTS,LRCOL99)) D
  1.  ..  ; duplicate auto np function
  1.  ..  ;
  1.  ..  Q:$D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS))  ;no excepted test
  1.  ..  Q:$D(^LRHY(69.86,LRHYSITE,25,1,"B",LRTSTS))  ;no order label tests
  1.  ..  Q:$D(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99))
  1.  ..  ;
  1.  ..  S LRIENZZ=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0))
  1.  ..  K ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN)
  1.  ..  K LRNPZZX
  1.  ..  I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRHYHOK=1 QUIT
  1.  ..  I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNPZZX(LRORD,LR3SN,LRTSTS)="" S LRNODUP=1 S LRHYHOK=+LRTSTS QUIT
  1.  ..  ; a future enhancement may be used to cancel a test
  1.  ..  S LRT(LRTSTS)=LR3SN_U_LRIENZZ_U_LRTSTS S LRJ=LRTSTS
  1.  ..  ;
  1.  ..  K LRCCOMX,LRCCOM0,LRCCOM1
  1.  ..  I $G(^LRHY(69.86,LRHYSITE,52))="" S LRNODUP=1
  1.  ..  I $G(^LRHY(69.86,LRHYSITE,52))="N" S LRNODUP=1
  1.  ..  Q:$G(LRNODUP)  S LRHYHOK=1 K LRCCOM S ZTRTN="FX2^LRHYDEL",ZTSAVE("L*")="",ZTDTH=$H,ZTIO="NULL" S:$D(ZTQUEUED) ZTREQ="@" D ^%ZTLOAD
  1.  ..  H 5
  1.  .  E  D
  1.  ..  Q:$D(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
  1.  ..  Q:$D(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
  1.  ..  Q:$D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS))  ;no excepted test
  1.  ..  Q:$D(^LRHY(69.86,LRHYSITE,25,1,"B",LRTSTS))  ;no order label tests
  1.  ..  Q:$D(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99))
  1.  ..  Q:$D(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
  1.  ..  K LRNPZZX
  1.  ..  I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNPZZX(LRORD,LR3SN,LRTSTS)="" S LRNODUP=1 S LRHYHOK=+LRTSTS QUIT
  1.  ..  ;
  1.  ..  I LR3DTN=DT S ^TMP("LRHYDY",$J,"DUPTEST",LRTSTS,LRCOL99)=""
  1.  ;
  1.  D DONE
  1.  QUIT
  1.  ;
  1. CSE ; This block checks for collection sample exclusion
  1.  S LRHYHOK=0
  1.  S LRHYSPC7=$P($G(^LAB(62,LRCOL99,0)),U,2)
  1.  I $G(LRHYSPC7) I $D(^LRHY(69.86,LRHYSITE,6,"B",LRHYSPC7)) S LRHYHOK=1
  1.  K LRNODONE
  1.  I $D(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99)) S LRHYHOK=1
  1.  I LRHYHOK=1 S LRHYCS33(LR3DTN,LR3SN)=LRCOL99
  1.  QUIT
  1.  ;
  1. CSTATUS ; This block checks for collection types to exclude
  1.  S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
  1.  K LRNODONE
  1.  K LRWCZZZ
  1.  S LRHYHOK=0
  1.  I $D(^LRHY(69.86,LRHYSITE,8,"B",LRCSTAT)) S LRHYHOK=1 S LRWCZZZ=1
  1.  I LRHYHOK=1 S ^TMP("LRHYDY",$J,"STATUS",LRORD)=""
  1.  D DONE
  1.  QUIT
  1.  ;
  1. EXLOC ; This block checks for Hospital locations to exclude
  1.  ;
  1.  I LR3DTN=DT Q
  1.  ;
  1.  ; This logic is to look for tests from an excluded location on the same specimen
  1.  ; number as tests from a non-excluded location because of orders being merged.
  1.  ; Variable LRLOCS will indicate this situation and will trigger a "check with clerk"
  1.  ; message.
  1.  ;
  1.  N LREX,LRNONEX,LRX,LRXX,LRMGINFO,LRMGDT,LRMGSN,LRXXLOC
  1.  I $D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) S LREX=1
  1.  I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) S LRNONEX=1
  1.  ;
  1.  S LRTSTS=0
  1.  F  S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0  D  Q:$G(LRLOCS)
  1.  . S LR3ZTST=0
  1.  . S LR3ZTST=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,LR3ZTST)) Q:+LR3ZTST'>0
  1.  . ;
  1.  . S LRX=$G(^LRO(69,LR3DTN,1,LR3SN,2,LR3ZTST,0))
  1.  . S LRMGINFO=$P(LRX,U,14)
  1.  . Q:LRMGINFO=""
  1.  . S LRMGDT=$P(LRMGINFO,";",1),LRMGSN=$P(LRMGINFO,";",2)
  1.  . S LRXX=$G(^LRO(69,LRMGDT,1,LRMGSN,0)),LRXXLOC=$P(LRXX,U,9)
  1.  . Q:LRXXLOC=""
  1.  . ;
  1.  . I $D(^LRHY(69.86,LRHYSITE,16,"B",LRXXLOC)),$G(LRNONEX)=1 S LRLOCS=1 Q
  1.  . I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRXXLOC)),$G(LREX)=1 S LRLOCS=1 Q
  1.  ;
  1.  I $G(LRLOCS) S LRHYHOK=1
  1.  I $D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) S LRHYHOK=1 D DONE S ^TMP("LRHYDY",$J,"EXLOC",LRORD,LRLLOC66,LR3SN)=""
  1.  QUIT
  1. DONE ;
  1.  Q:$D(LROLT1)
  1.  Q:$G(LRHYT654)
  1.  I $G(LRHYTOK) S LRHYHOK=0
  1.  Q:$G(LRNODONE)
  1.  I LRHYHOK=1 S ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN,1)=""
  1.  I LRHYHOK>1 S ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN,LRHYHOK)=""
  1.  QUIT
  1. URG ;
  1.  S LRHYHOK=0
  1.  S LRTSTS=0
  1.  F  S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0!(LRHYHOK)  D URGP
  1.  QUIT
  1.  D DONE
  1.  QUIT
  1. URGP ;
  1.  S LR3ZTST=0
  1.  S LR3ZTST=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,LR3ZTST)) Q:+LR3ZTST'>0!(LRHYHOK)  D URG1  Q:LRHYHOK
  1.  QUIT
  1. URG1 ;
  1.  S LRURGZ19=$P(^LRO(69,LR3DTN,1,LR3SN,2,LR3ZTST,0),U,2)
  1.  I $D(^LRHY(69.86,LRHYSITE,30,"B",LRURGZ19)) S LRHYHOK=1 S LRHYURG3(LR3DTN,LR3SN)=LR3ZTST
  1.  I LRHYHOK=1 S ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN,1)=""
  1.  S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
  1.  I LRHYHOK=1 S ^TMP("LRHYDY",$J,"URG",LRORD)=""
  1.  QUIT