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 ;VA/DALOI/HOAK - HOWDY UTILITY-A ; 13-Aug-2013 09:16 ; MKK
  1.  ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997
  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)="" 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 $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.  .  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.  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