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

LRHYU.m

Go to the documentation of this file.
  1. LRHYU ;DALOI/HOAK - HOWDY UTILITY CALLS 08/28/2005 ;12/1/10 11:29am
  1. ;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93
  1. ;
  1. ; Reference to DUZ^XUP supported by DBIA #4129
  1. ;
  1. ; This routine is looking for anomilies related to the specimen
  1. DUP ; from LRHYPH2 are there any duplicate tests
  1. S LRDUPT=0
  1. Q:+LRSN'>0 D
  1. . S LRHT1=0
  1. . F S LRHT1=$O(^LRO(69,LRODT,1,LRSN,2,"B",LRHT1)) Q:+LRHT1'>0 D
  1. .. I $D(^TMP("LRHYDY",$J,"LRHYDY",$J,LRDFN,LRORD,LRHT1)) S LRDUPT=1 QUIT
  1. QUIT
  1. EDIT ;
  1. ; Enable editing of Howdy site file
  1. S (DIB,DIE)=69.86 D EN^DIB
  1. QUIT
  1. D1 ;
  1. ; Check for specimen containing tests not to be accessioned.
  1. S LRHT1=0
  1. F S LRHT1=$O(^LRO(69,LRODT,1,LRSN,2,"B",LRHT1)) Q:+LRHT1'>0 D
  1. . S ^TMP("LRHYDY",$J,"LRHYDY",$J,LRDFN,LRORD,LRHT1)=""
  1. QUIT
  1. NINE ;
  1. S DIR(0)="FUO^9:9"
  1. S DIR("A")="Please scan your ID badge"
  1. D ^DIR
  1. QUIT
  1. XTMP ;
  1. N X,X1,X2
  1. S X1=DT,X2=365 D C^%DTC
  1. ; ^XTMP(namespaced- subscript,0)=purge date^create date^optional
  1. S ^XTMP("LRHY LABELS",0)=X_U_DT
  1. K ^TMP("LRHYDY",$J)
  1. K ^TMP("LRHYHOW1",$J)
  1. K ^TMP("LRHY ASH",$J)
  1. K ^TMP("LRHY3TST",$J)
  1. QUIT
  1. USER ;
  1. I '$G(LRHYSITE) S DIC=69.86,DIC(0)="AEMQZ" D ^DIC S LRHYSITE=+Y
  1. I '$G(LRHYSITE) W !,"SITE NOT SELECTED" H 2 QUIT
  1. K LRHYUSER S LRHYUSER=DUZ
  1. IF '$D(^LRHY(69.86,LRHYSITE,56)) W !,"NO HOWDY USER DEFINED. PERSON SIGNED ON WILL BE USED." QUIT
  1. IF $D(^LRHY(69.86,LRHYSITE,56)) N LRX S LRX=$G(^LRHY(69.86,LRHYSITE,56))
  1. IF $G(LRX) D DUZ^XUP(LRX)
  1. W !,$P(^VA(200,DUZ,0),U)," IS THE HOWDY USER."
  1. QUIT
  1. BAKUSER ;
  1. QUIT
  1. IF $G(LRHYUSER) D DUZ^XUP(LRHYUSER)
  1. K LRHYUSER