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