Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLRALRP

BLRALRP.m

Go to the documentation of this file. 
  1. BLRALRP ;DAOU/ALA-Lab Audit Reports [ 11/18/2002  1:37 PM ]
  1.  ;;5.2;LR;**1013,1015**;NOV 18, 2002
  1.  ;
  1.  ;**Program Description**
  1.  ;  These are reports to view information about the Lab Audit
  1.  ;
  1. OPT W !,"     Report Options"
  1.  W !!," 1) By Date Range "
  1.  W !," 2) By Single Date "
  1.  W !," 3) By User "
  1.  W !," 4) By Menu Option"
  1.  W !," 5) QUIT"
  1.  S DIR("A")="Select Report Option",DIR(0)="L^1:5" D ^DIR
  1.  I Y=U!(Y="") G EXIT
  1.  S BLRSLCT=$E(Y,$L(Y)-1)
  1.  I BLRSLCT["," K Y,X W !,"Please select one option at a time" G OPT
  1.  K X,Y,DIR
  1.  ;
  1.  S $P(SPACES," ",55)=" "   ; used within Report Header
  1.  ;
  1.  I BLRSLCT=1 D RNGE G EXIT
  1.  I BLRSLCT=2 D DATE G EXIT
  1.  I BLRSLCT=3 D USER G EXIT
  1.  I BLRSLCT=4 D MENU G EXIT
  1.  G EXIT
  1.  S QFL=0
  1.  ;  Look up menu options
  1.  W !,"   Select Menu Option(s):"
  1.  D MEN^BLRALUT
  1.  I $G(BLRAVAL)=""!($G(BLRAVAL)=U) Q
  1.  ;
  1.  ;  Sort out and save data to temporary global
  1.  F BLRAJ=1:1 S BLRAI=$P(BLRAVAL,",",BLRAJ) Q:BLRAI=""  D  Q:QFL
  1.  . S BLRADTA=$G(^TMP($J,"BLRAUSC",BLRAI))
  1.  . S L=0,DIC="^BLRALAB(9009027,",DHD="*** CONFIDENTIAL DATA ***"_SPACES_"BLRA LAB AUDIT REPORT BY MENU OPTION: "_$P(BLRADTA,U)
  1.  . S FLDS="[BLRA LAB AUDIT REPORT]"
  1.  . S BLRAUI=$P(BLRADTA,U,1)
  1.  . S BY=.03,FR(1)=BLRAUI,TO(1)=BLRAUI
  1.  . D EN1^DIP
  1.  . I $E(IOST,1,2)="C-" R !,"Press return to continue, '^' to Quit",BLRNS:DTIME
  1.  . I BLRNS=U S QFL=1
  1.  Q
  1.  ;
  1. USER ;  Report by User
  1.  S QFL=0
  1.  ;  Select users
  1.  W !,"   Select User(s):"
  1.  D ULK^BLRALUT
  1.  I $G(BLRAVAL)=""!($G(BLRAVAL)=U) Q
  1.  ;
  1.  ;  Sort out and save data to temporary global
  1.  F BLRAJ=1:1 S BLRAI=$P(BLRAVAL,",",BLRAJ) Q:BLRAI=""  D  Q:QFL
  1.  . S BLRADTA=$G(^TMP($J,"BLRAUSC",BLRAI))
  1.  . S L=0,DIC="^BLRALAB(9009027,",DHD="*** CONFIDENTIAL DATA ***"_SPACES_"LAB AUDIT REPORT BY USER: "_$P(BLRADTA,U)
  1.  . S FLDS="[BLRA LAB AUDIT REPORT]"
  1.  . S BLRAUI=$P(BLRADTA,U,1)
  1.  . S BY=.02,FR(1)=BLRAUI,TO(1)=BLRAUI
  1.  . D EN1^DIP
  1.  . I $E(IOST,1,2)="C-" R !,"Press return to continue, '^' to Quit",BLRNS:DTIME
  1.  . I BLRNS=U S QFL=1
  1.  Q
  1.  ;
  1. RNGE ;  Date Range
  1.  K BLRNS
  1.  S %DT("A")="Date to START with: ",%DT="AE" D ^%DT S LRSDT=Y
  1.  S %DT("A")="Date to END with: ",%DT="AE" D ^%DT S LREDT=Y
  1.  I LRSDT=U!(LREDT=U)!(LRSDT=-1)!(LREDT=-1) Q
  1.  S RLRSDT=$$HLDATE^HLFNC(LRSDT),RLREDT=$$HLDATE^HLFNC(LREDT)
  1.  S RLRSDT1=$E(RLRSDT,5,6)_"/"_$E(RLRSDT,7,8)_"/"_$E(RLRSDT,1,4)
  1.  S RLREDT1=$E(RLREDT,5,6)_"/"_$E(RLREDT,7,8)_"/"_$E(RLREDT,1,4)
  1.  S L=0,DIC="^BLRALAB(9009027,",DHD="*** CONFIDENTIAL DATA ***"_SPACES_"LAB AUDIT REPORT BY DATE RANGE: "_RLRSDT1_" THRU "_RLREDT1
  1.  S FLDS="[BLRA LAB AUDIT REPORT]"
  1.  S FR=LRSDT,TO=(LREDT\1),BY=.01
  1.  D EN1^DIP
  1.  I $E(IOST,1,2)="C-" R !,"Press return to continue",BLRNS:DTIME
  1.  Q
  1.  ;
  1. EXIT D ^%ZISC
  1.  K BLRADTA,BLRAUI,BLRNS,QFL,BLRAVAL,BLRAJ,BLRAI,LREDT,LREND,LRSDT,DIR
  1.  K BLRSLCT,BLCT,BLRACT,BLRACTN,BLRAU,BLRAUN,BLRNS
  1.  Q
  1.  ;
  1. DATE ;  Report by a single date
  1.  S %DT("A")="Date to RUN with: ",%DT="AE" D ^%DT S LRSDT=Y
  1.  I LRSDT=U!(LRSDT=-1) Q
  1.  S RDTE=$$HLDATE^HLFNC(LRSDT)
  1.  S RDTE1=$E(RDTE,5,6)_"/"_$E(RDTE,7,8)_"/"_$E(RDTE,1,4)
  1.  S L=0,DIC="^BLRALAB(9009027,",DHD="*** CONFIDENTIAL DATA ***"_SPACES_"LAB AUDIT REPORT BY SINGLE DATE: "_RDTE1
  1.  S FLDS="[BLRA LAB AUDIT REPORT]"
  1.  S FR=LRSDT,TO=LRSDT,BY=.01
  1.  D EN1^DIP
  1.  I $E(IOST,1,2)="C-" R !,"Press return to continue",BLRNS:DTIME
  1.  Q
  1. MENCON(MIEN) ; Convert Menu Option name to Menu Text for Audit Printout
  1.  ;
  1.  N MTXT
  1.  I MIEN="" Q ""
  1.  S MIEN=$$GET1^DIQ(9009027,MIEN,.03,"I")
  1.  S MTXT=$$GET1^DIQ(19,MIEN,.01,"E")
  1.  I MTXT="LRRP2" S MTXT="INT RPT-IR"
  1.  I MTXT="LRRD" S MTXT="IR BY MD"
  1.  I MTXT="LRRS" S MTXT="IR BY LOC"
  1.  I MTXT="LRRS BY LOC" S MTXT="IR FOR 1 LOC"
  1.  I MTXT="BLR LRRD BY MD" S MTXT="IR FOR 1 MD"
  1.  I MTXT="BLRA LAB REVIEW/SIGN RESULTS" S MTXT="E-SIG REVIEW"
  1.  Q MTXT