- 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
