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