- LRRP7 ; IHS/DIR/AAB - MANUAL WKLD STATS REPORT 8/11/97 ; [ 07/22/2002 1:41 PM ]
- ;;5.2;LR;**1003,1013**;JUL 15, 2002
- ;;5.2;LAB SERVICE;**1,63,121**;Sep 27, 1994
- EN ;*** Entry point and control block ***
- S LREND=0
- D ASK
- DQ ;
- D:'LREND INIT
- D:'LREND BUILD
- D:'LREND PRNTMAN^LRCAPMR1
- D CLN
- Q
- ;
- INIT ;*** Initialize some variables ***
- K ^TMP("LR",$J)
- U IO
- W:$E(IOST,1,2)="C-" @IOF
- D PRTINIT^LRCAPU
- S LRHDR="WORKLOAD STATISTICS BY ACCESSION AREA AND SHIFTS"
- S LRHDR2=LRDTH
- Q
- ;
- CLN ;*** Clean up ***
- D ^%ZISC,PRTCLN^LRCAPU,WKLDCLN^LRCAPU,CLNMAN^LRCAPMR1
- K ^TMP("LR",$J)
- K LRCDT,LRFR,LRFRV,LRFRD,LRTO,LRTOV,LRTOD,LRDTH,LRDSH,LRSTRT,LRSTOP,LRUC
- K LRCAPS,LRCC,LRCAPNAM,LRCAPNUM,LRCAPFLG,LRCAPIFN,LRA,LRAA,LRCCNT,LRANAM
- K LRREC,LRTIM,LRRPT,LREND,LRST,LRSTFLG,LRNSFT,LRSHFT,LRIN,LRPCT,LRSCNT
- K LRACNT,LRGCNT,LRCONT,LRSQRM,LRMNODE,LRGSTND,LRGQC,LRGRPT,LRGMANL,LRDR
- K LRDATE,LRCOM,LRTCOM,LRCOMM,LRCM
- K DIC,DIR,X,Y,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK,DTOUT,DUOUT,DIRUT
- Q
- ASK ;
- D INST Q:LREND
- D DATE^LRCAPR1A S:Y=-1 LREND=1
- D CAPS Q:LREND
- D DEVICE Q:LREND
- Q
- INST ;*** Query for institution ***
- K DIC
- W @IOF,!
- S DIC="^LRO(64.1,",DIC(0)="AQENM" D ^DIC
- I (+Y<0)!($D(DUOUT))!($D(DTOUT)) S LREND=1 Q
- S LRIN=+Y
- Q
- CAPS ;*** Query for CAP codes ***
- N I S LRCAPS=0 K DIR,X,Y
- S DIR(0)="S^Y:YES;N:NO",DIR("B")="NO"
- S DIR("A")="Do you want to select workload codes (YES or NO) "
- S DIR("?",1)="Enter 'NO' to include ALL workload codes."
- S DIR("?")="Enter 'YES' to limit report to one or more workload codes."
- D ^DIR
- Q:Y="N"
- I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
- W !
- S DIC="^LAM(",DIC(0)="AQENM",DIC("A")="Select WKLD code:"
- F I=1:1 D ^DIC Q:Y=-1 S LRCAPS(+Y)=$P(Y,U),LRCAPS=I
- S:($D(DTOUT))!($D(DUOUT)) LREND=1
- Q
- DEVICE ;
- K %ZIS,POP S %ZIS="Q" D ^%ZIS
- I POP S LREND=1 Q
- I $D(IO("Q")) D QUE S LREND=1
- Q
- QUE ;
- S ZTSAVE("LR*")="",ZTRTN="DQ^LRRP7",ZTDESC="LR MANUAL WKLD REPORT"
- D ^%ZTLOAD,^%ZISC
- W:$G(ZTSK) !!,"TASK ",ZTSK," QUEUED." H 3
- Q
- BUILD ;
- N LRGCN,LRCCN,LRDCN,X
- S ^TMP("LR",$J,0)=0
- D INITMAN^LRCAPMR1
- I LRTO>LRFR S X=LRFR,LRFR=LRTO,LRTO=X
- S LRCDT=LRTO-1
- F S LRCDT=$O(^LRO(64.1,LRIN,1,LRCDT)) Q:('LRCDT)!(LRCDT>LRFR) D
- . S LRCC=0
- . F S LRCC=$O(^LRO(64.1,LRIN,1,LRCDT,1,LRCC)) Q:'LRCC D
- . . I LRCAPS Q:'$D(LRCAPS(LRCC))
- . . S LRCAPNAM=$$WKLDNAME^LRCAPU(LRCC)
- . . D BMPMANL^LRCAPMR1
- Q
- LRRP7 ; IHS/DIR/AAB - MANUAL WKLD STATS REPORT 8/11/97 ; [ 07/22/2002 1:41 PM ]
- +1 ;;5.2;LR;**1003,1013**;JUL 15, 2002
- +2 ;;5.2;LAB SERVICE;**1,63,121**;Sep 27, 1994
- EN ;*** Entry point and control block ***
- +1 SET LREND=0
- +2 DO ASK
- DQ ;
- +1 IF 'LREND
- DO INIT
- +2 IF 'LREND
- DO BUILD
- +3 IF 'LREND
- DO PRNTMAN^LRCAPMR1
- +4 DO CLN
- +5 QUIT
- +6 ;
- INIT ;*** Initialize some variables ***
- +1 KILL ^TMP("LR",$JOB)
- +2 USE IO
- +3 IF $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- +4 DO PRTINIT^LRCAPU
- +5 SET LRHDR="WORKLOAD STATISTICS BY ACCESSION AREA AND SHIFTS"
- +6 SET LRHDR2=LRDTH
- +7 QUIT
- +8 ;
- CLN ;*** Clean up ***
- +1 DO ^%ZISC
- DO PRTCLN^LRCAPU
- DO WKLDCLN^LRCAPU
- DO CLNMAN^LRCAPMR1
- +2 KILL ^TMP("LR",$JOB)
- +3 KILL LRCDT,LRFR,LRFRV,LRFRD,LRTO,LRTOV,LRTOD,LRDTH,LRDSH,LRSTRT,LRSTOP,LRUC
- +4 KILL LRCAPS,LRCC,LRCAPNAM,LRCAPNUM,LRCAPFLG,LRCAPIFN,LRA,LRAA,LRCCNT,LRANAM
- +5 KILL LRREC,LRTIM,LRRPT,LREND,LRST,LRSTFLG,LRNSFT,LRSHFT,LRIN,LRPCT,LRSCNT
- +6 KILL LRACNT,LRGCNT,LRCONT,LRSQRM,LRMNODE,LRGSTND,LRGQC,LRGRPT,LRGMANL,LRDR
- +7 KILL LRDATE,LRCOM,LRTCOM,LRCOMM,LRCM
- +8 KILL DIC,DIR,X,Y,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK,DTOUT,DUOUT,DIRUT
- +9 QUIT
- ASK ;
- +1 DO INST
- IF LREND
- QUIT
- +2 DO DATE^LRCAPR1A
- IF Y=-1
- SET LREND=1
- +3 DO CAPS
- IF LREND
- QUIT
- +4 DO DEVICE
- IF LREND
- QUIT
- +5 QUIT
- INST ;*** Query for institution ***
- +1 KILL DIC
- +2 WRITE @IOF,!
- +3 SET DIC="^LRO(64.1,"
- SET DIC(0)="AQENM"
- DO ^DIC
- +4 IF (+Y<0)!($DATA(DUOUT))!($DATA(DTOUT))
- SET LREND=1
- QUIT
- +5 SET LRIN=+Y
- +6 QUIT
- CAPS ;*** Query for CAP codes ***
- +1 NEW I
- SET LRCAPS=0
- KILL DIR,X,Y
- +2 SET DIR(0)="S^Y:YES;N:NO"
- SET DIR("B")="NO"
- +3 SET DIR("A")="Do you want to select workload codes (YES or NO) "
- +4 SET DIR("?",1)="Enter 'NO' to include ALL workload codes."
- +5 SET DIR("?")="Enter 'YES' to limit report to one or more workload codes."
- +6 DO ^DIR
- +7 IF Y="N"
- QUIT
- +8 IF ($DATA(DTOUT))!($DATA(DUOUT))
- SET LREND=1
- QUIT
- +9 WRITE !
- +10 SET DIC="^LAM("
- SET DIC(0)="AQENM"
- SET DIC("A")="Select WKLD code:"
- +11 FOR I=1:1
- DO ^DIC
- IF Y=-1
- QUIT
- SET LRCAPS(+Y)=$PIECE(Y,U)
- SET LRCAPS=I
- +12 IF ($DATA(DTOUT))!($DATA(DUOUT))
- SET LREND=1
- +13 QUIT
- DEVICE ;
- +1 KILL %ZIS,POP
- SET %ZIS="Q"
- DO ^%ZIS
- +2 IF POP
- SET LREND=1
- QUIT
- +3 IF $DATA(IO("Q"))
- DO QUE
- SET LREND=1
- +4 QUIT
- QUE ;
- +1 SET ZTSAVE("LR*")=""
- SET ZTRTN="DQ^LRRP7"
- SET ZTDESC="LR MANUAL WKLD REPORT"
- +2 DO ^%ZTLOAD
- DO ^%ZISC
- +3 IF $GET(ZTSK)
- WRITE !!,"TASK ",ZTSK," QUEUED."
- HANG 3
- +4 QUIT
- BUILD ;
- +1 NEW LRGCN,LRCCN,LRDCN,X
- +2 SET ^TMP("LR",$JOB,0)=0
- +3 DO INITMAN^LRCAPMR1
- +4 IF LRTO>LRFR
- SET X=LRFR
- SET LRFR=LRTO
- SET LRTO=X
- +5 SET LRCDT=LRTO-1
- +6 FOR
- SET LRCDT=$ORDER(^LRO(64.1,LRIN,1,LRCDT))
- IF ('LRCDT)!(LRCDT>LRFR)
- QUIT
- Begin DoDot:1
- +7 SET LRCC=0
- +8 FOR
- SET LRCC=$ORDER(^LRO(64.1,LRIN,1,LRCDT,1,LRCC))
- IF 'LRCC
- QUIT
- Begin DoDot:2
- +9 IF LRCAPS
- IF '$DATA(LRCAPS(LRCC))
- QUIT
- +10 SET LRCAPNAM=$$WKLDNAME^LRCAPU(LRCC)
- +11 DO BMPMANL^LRCAPMR1
- End DoDot:2
- End DoDot:1
- +12 QUIT
