BLRALUT ;DAOU/ALA-Lab Audit Utility [ 11/18/2002 1:38 PM ]
;;5.2;LR;**1013,1015**;NOV 18, 2002
;
;**Program Description**
; This contains utilities for Lab Audit
;
ULK ;EP
; User Lookup
K ^TMP($J,"BLRAU"),^TMP($J,"BLRAUSC")
S BLRAU="",BLCT=0,BLRACTN=0
F S BLRAU=$O(^BLRALAB(9009027,"C",BLRAU)) Q:'BLRAU D
. S BLRAUN=$$GET1^DIQ(200,BLRAU,.01,"E")
. Q:$D(^TMP($J,"BLRAU",BLRAUN))
. S BLCT=BLCT+1
. S ^TMP($J,"BLRAU",BLRAUN)=""
. S ^TMP($J,"BLRAUSC",BLCT)=BLRAUN_U_BLRAU
;
S BLRAU="",QFL=0,BLRACT=""
F S BLRACT=$O(^TMP($J,"BLRAUSC",BLRACT)) Q:BLRACT="" D Q:QFL
. S BLRACTN=BLRACT
. W !,?10,BLRACT_" "_$P($G(^TMP($J,"BLRAUSC",BLRACT)),U,1)
. I BLRACT#10=0 S QFL=0 D PRET Q:QFL
;
CHS S DIR(0)="L^1:"_BLRACTN D ^DIR
K DIR
I $G(BLRANS)=U Q
;
S BLRAVAL=Y
Q
;-------------------------------------------------------------
PRET W !,"Press <RETURN> to see more OR '^' to exit: "
R BLRANS:DTIME
I BLRANS=U S QFL=1
Q
;
MEN ;EP
; Menu Lookup
;
K ^TMP($J,"BLRAU"),^TMP($J,"BLRAUSC")
N BLRAMTXT
S BLRAU="",BLCT=0,BLRACTN=0,BLRAMTXT=""
F S BLRAU=$O(^BLRALAB(9009027,"D",BLRAU)) Q:'BLRAU D
. I BLRAU=-1 Q ;Safety check if "D" not created correctly -ejn
. S BLRAUN=$$GET1^DIQ(19,BLRAU,.01,"E")
. S BLRAMTXT=$$GET1^DIQ(19,BLRAU,1,"E")
. Q:$D(^TMP($J,"BLRAU",BLRAUN))
. S BLCT=BLCT+1
. S ^TMP($J,"BLRAU",BLRAUN)=""
. S ^TMP($J,"BLRAUSC",BLCT)=BLRAUN_U_BLRAU_U_BLRAMTXT
;
S BLRAU="",QFL=0,BLRACT=""
F S BLRACT=$O(^TMP($J,"BLRAUSC",BLRACT)) Q:BLRACT="" D Q:QFL
. S BLRACTN=BLRACT
. W !,?10,BLRACT_" "_$P($G(^TMP($J,"BLRAUSC",BLRACT)),U,3)
. I BLRACT#10=0 S QFL=0 D PRET Q:QFL
;
D CHS
Q
BLRALUT ;DAOU/ALA-Lab Audit Utility [ 11/18/2002 1:38 PM ]
+1 ;;5.2;LR;**1013,1015**;NOV 18, 2002
+2 ;
+3 ;**Program Description**
+4 ; This contains utilities for Lab Audit
+5 ;
ULK ;EP
+1 ; User Lookup
+2 KILL ^TMP($JOB,"BLRAU"),^TMP($JOB,"BLRAUSC")
+3 SET BLRAU=""
SET BLCT=0
SET BLRACTN=0
+4 FOR
SET BLRAU=$ORDER(^BLRALAB(9009027,"C",BLRAU))
IF 'BLRAU
QUIT
Begin DoDot:1
+5 SET BLRAUN=$$GET1^DIQ(200,BLRAU,.01,"E")
+6 IF $DATA(^TMP($JOB,"BLRAU",BLRAUN))
QUIT
+7 SET BLCT=BLCT+1
+8 SET ^TMP($JOB,"BLRAU",BLRAUN)=""
+9 SET ^TMP($JOB,"BLRAUSC",BLCT)=BLRAUN_U_BLRAU
End DoDot:1
+10 ;
+11 SET BLRAU=""
SET QFL=0
SET BLRACT=""
+12 FOR
SET BLRACT=$ORDER(^TMP($JOB,"BLRAUSC",BLRACT))
IF BLRACT=""
QUIT
Begin DoDot:1
+13 SET BLRACTN=BLRACT
+14 WRITE !,?10,BLRACT_" "_$PIECE($GET(^TMP($JOB,"BLRAUSC",BLRACT)),U,1)
+15 IF BLRACT#10=0
SET QFL=0
DO PRET
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+16 ;
CHS SET DIR(0)="L^1:"_BLRACTN
DO ^DIR
+1 KILL DIR
+2 IF $GET(BLRANS)=U
QUIT
+3 ;
+4 SET BLRAVAL=Y
+5 QUIT
+6 ;-------------------------------------------------------------
PRET WRITE !,"Press <RETURN> to see more OR '^' to exit: "
+1 READ BLRANS:DTIME
+2 IF BLRANS=U
SET QFL=1
+3 QUIT
+4 ;
MEN ;EP
+1 ; Menu Lookup
+2 ;
+3 KILL ^TMP($JOB,"BLRAU"),^TMP($JOB,"BLRAUSC")
+4 NEW BLRAMTXT
+5 SET BLRAU=""
SET BLCT=0
SET BLRACTN=0
SET BLRAMTXT=""
+6 FOR
SET BLRAU=$ORDER(^BLRALAB(9009027,"D",BLRAU))
IF 'BLRAU
QUIT
Begin DoDot:1
+7 ;Safety check if "D" not created correctly -ejn
IF BLRAU=-1
QUIT
+8 SET BLRAUN=$$GET1^DIQ(19,BLRAU,.01,"E")
+9 SET BLRAMTXT=$$GET1^DIQ(19,BLRAU,1,"E")
+10 IF $DATA(^TMP($JOB,"BLRAU",BLRAUN))
QUIT
+11 SET BLCT=BLCT+1
+12 SET ^TMP($JOB,"BLRAU",BLRAUN)=""
+13 SET ^TMP($JOB,"BLRAUSC",BLCT)=BLRAUN_U_BLRAU_U_BLRAMTXT
End DoDot:1
+14 ;
+15 SET BLRAU=""
SET QFL=0
SET BLRACT=""
+16 FOR
SET BLRACT=$ORDER(^TMP($JOB,"BLRAUSC",BLRACT))
IF BLRACT=""
QUIT
Begin DoDot:1
+17 SET BLRACTN=BLRACT
+18 WRITE !,?10,BLRACT_" "_$PIECE($GET(^TMP($JOB,"BLRAUSC",BLRACT)),U,3)
+19 IF BLRACT#10=0
SET QFL=0
DO PRET
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+20 ;
+21 DO CHS
+22 QUIT
