- 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 Feb 18, 2025@23:41:22 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