LRHYU.m

LRHYU ;VA/DALOI/HOAK - HOWDY UTILITY CALLS 08/28/2005 ; 13-Aug-2013 09:16 ; MKK

 ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997

 ;

 ; 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

LRHYU     ;VA/DALOI/HOAK - HOWDY UTILITY CALLS 08/28/2005 ; 13-Aug-2013 09:16 ; MKK

 +1       ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997

 +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