LRHYU ;DALOI/HOAK - HOWDY UTILITY CALLS 08/28/2005 ;12/1/10 11:29am
;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93
;
; Reference to DUZ^XUP supported by DBIA #4129
;
; This routine is looking for anomilies related to the specimen
DUP ; from LRHYPH2 are there any duplicate tests
S LRDUPT=0
Q:+LRSN'>0 D
. S LRHT1=0
. F S LRHT1=$O(^LRO(69,LRODT,1,LRSN,2,"B",LRHT1)) Q:+LRHT1'>0 D
.. I $D(^TMP("LRHYDY",$J,"LRHYDY",$J,LRDFN,LRORD,LRHT1)) S LRDUPT=1 QUIT
QUIT
EDIT ;
; Enable editing of Howdy site file
S (DIB,DIE)=69.86 D EN^DIB
QUIT
D1 ;
; Check for specimen containing tests not to be accessioned.
S LRHT1=0
F S LRHT1=$O(^LRO(69,LRODT,1,LRSN,2,"B",LRHT1)) Q:+LRHT1'>0 D
. S ^TMP("LRHYDY",$J,"LRHYDY",$J,LRDFN,LRORD,LRHT1)=""
QUIT
NINE ;
S DIR(0)="FUO^9:9"
S DIR("A")="Please scan your ID badge"
D ^DIR
QUIT
XTMP ;
N X,X1,X2
S X1=DT,X2=365 D C^%DTC
; ^XTMP(namespaced- subscript,0)=purge date^create date^optional
S ^XTMP("LRHY LABELS",0)=X_U_DT
K ^TMP("LRHYDY",$J)
K ^TMP("LRHYHOW1",$J)
K ^TMP("LRHY ASH",$J)
K ^TMP("LRHY3TST",$J)
QUIT
USER ;
I '$G(LRHYSITE) S DIC=69.86,DIC(0)="AEMQZ" D ^DIC S LRHYSITE=+Y
I '$G(LRHYSITE) W !,"SITE NOT SELECTED" H 2 QUIT
K LRHYUSER S LRHYUSER=DUZ
IF '$D(^LRHY(69.86,LRHYSITE,56)) W !,"NO HOWDY USER DEFINED. PERSON SIGNED ON WILL BE USED." QUIT
IF $D(^LRHY(69.86,LRHYSITE,56)) N LRX S LRX=$G(^LRHY(69.86,LRHYSITE,56))
IF $G(LRX) D DUZ^XUP(LRX)
W !,$P(^VA(200,DUZ,0),U)," IS THE HOWDY USER."
QUIT
BAKUSER ;
QUIT
IF $G(LRHYUSER) D DUZ^XUP(LRHYUSER)
K LRHYUSER
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHYU 1601 printed Dec 13, 2024@02:15:29 Page 2
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
+2 ;
+3 ; Reference to DUZ^XUP supported by DBIA #4129
+4 ;
+5 ; This routine is looking for anomilies related to the specimen
DUP ; from LRHYPH2 are there any duplicate tests
+1 SET LRDUPT=0
+2 if +LRSN'>0
QUIT
Begin DoDot:1
+3 SET LRHT1=0
+4 FOR
SET LRHT1=$ORDER(^LRO(69,LRODT,1,LRSN,2,"B",LRHT1))
if +LRHT1'>0
QUIT
Begin DoDot:2
+5 IF $DATA(^TMP("LRHYDY",$JOB,"LRHYDY",$JOB,LRDFN,LRORD,LRHT1))
SET LRDUPT=1
QUIT
End DoDot:2
End DoDot:1
+6 QUIT
EDIT ;
+1 ; Enable editing of Howdy site file
+2 SET (DIB,DIE)=69.86
DO EN^DIB
+3 QUIT
D1 ;
+1 ; Check for specimen containing tests not to be accessioned.
+2 SET LRHT1=0
+3 FOR
SET LRHT1=$ORDER(^LRO(69,LRODT,1,LRSN,2,"B",LRHT1))
if +LRHT1'>0
QUIT
Begin DoDot:1
+4 SET ^TMP("LRHYDY",$JOB,"LRHYDY",$JOB,LRDFN,LRORD,LRHT1)=""
End DoDot:1
+5 QUIT
NINE ;
+1 SET DIR(0)="FUO^9:9"
+2 SET DIR("A")="Please scan your ID badge"
+3 DO ^DIR
+4 QUIT
XTMP ;
+1 NEW X,X1,X2
+2 SET X1=DT
SET X2=365
DO C^%DTC
+3 ; ^XTMP(namespaced- subscript,0)=purge date^create date^optional
+4 SET ^XTMP("LRHY LABELS",0)=X_U_DT
+5 KILL ^TMP("LRHYDY",$JOB)
+6 KILL ^TMP("LRHYHOW1",$JOB)
+7 KILL ^TMP("LRHY ASH",$JOB)
+8 KILL ^TMP("LRHY3TST",$JOB)
+9 QUIT
USER ;
+1 IF '$GET(LRHYSITE)
SET DIC=69.86
SET DIC(0)="AEMQZ"
DO ^DIC
SET LRHYSITE=+Y
+2 IF '$GET(LRHYSITE)
WRITE !,"SITE NOT SELECTED"
HANG 2
QUIT
+3 KILL LRHYUSER
SET LRHYUSER=DUZ
+4 IF '$DATA(^LRHY(69.86,LRHYSITE,56))
WRITE !,"NO HOWDY USER DEFINED. PERSON SIGNED ON WILL BE USED."
QUIT
+5 IF $DATA(^LRHY(69.86,LRHYSITE,56))
NEW LRX
SET LRX=$GET(^LRHY(69.86,LRHYSITE,56))
+6 IF $GET(LRX)
DO DUZ^XUP(LRX)
+7 WRITE !,$PIECE(^VA(200,DUZ,0),U)," IS THE HOWDY USER."
+8 QUIT
BAKUSER ;
+1 QUIT
+2 IF $GET(LRHYUSER)
DO DUZ^XUP(LRHYUSER)
+3 KILL LRHYUSER
