- LRRP8A ;DALISC/TNN/J0 - WKLD STATS REPORT BY SHIFT ; 4/9/93
- ;;5.2;LAB SERVICE;**63**;Sep 27, 1994
- W !!,"ENTRY POINT IS AT EN^LRRP8." H 3 QUIT
- ;
- ASK ;
- D INST Q:LREND
- D ACCAREA Q:LREND
- D DATES Q:LREND
- D CAPS Q:LREND
- D TIMES Q:LREND
- D REPTYP 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
- ACCAREA ;*** Query for accession areas ***
- S LRAA=0
- K DIR,X,Y S DIR(0)="S^Y:YES;N:NO",DIR("B")="NO"
- S DIR("A")="Do you want to select accession areas (YES or NO) "
- S DIR("?",1)="Enter 'NO' to include ALL accession areas."
- S DIR("?")="Enter 'YES' to limit report to one or more accession areas."
- D ^DIR
- Q:Y="N"
- I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
- K DIC S DIC=68,DIC(0)="AEMQZ"
- F D ^DIC Q:Y=-1 D
- .S LRAA=+Y,LRAA(+Y)=$P(Y(0),U,11)
- I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
- Q
- DATES ;*** Query for date ***
- W !,"DATE selection:"
- K DIR,X,Y S DIR(0)="S^1:A specific date;2:A range of dates"
- D ^DIR
- I $D(DIRUT)!($D(DUOUT)) S LREND=1 Q
- I X=1 D QDT Q
- D DATE^LRCAPR1A S:Y=-1 LREND=1
- 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
- TIMES ;*** Query for type of time search ***
- W !,"TIME selection:"
- K DIR S DIR(0)="S^1:A time range;2:A set of shifts"
- D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S LREND=1 Q
- I X=2 D QST Q
- D QTR I ($G(LRSTRT)<0)!($G(LRSTOP)<0) S LREND=1
- Q
- REPTYP ;*** Query for type of type of report ***
- W !,"REPORT selection:"
- K DIR S DIR(0)="S^1:Detail report;2:Summary report"
- D ^DIR
- I $D(DTOUT)!($D(DUOUT)) S LREND=1 Q
- S LRRPT=+X
- 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^LRRP8",ZTDESC="LR WKLD SHIFT REPORT"
- S:$G(LRAA) ZTSAVE("LRAA*")=""
- D ^%ZTLOAD,^%ZISC
- W:$G(ZTSK) !!,"TASK ",ZTSK," QUEUED." H 3
- Q
- QDT ;*** Query for a specific date ***
- W !
- S DIC="^LRO(64.1,"_LRIN_",1,",DIC(0)="AQENM" D ^DIC
- I Y=-1 S LREND=1 Q
- S (LRDATE,LRFR,LRTO)=+Y,LRDR=1 D DD^%DT
- S LRDTH="For: "_Y
- Q
- QST ;*** Query for shifts ***
- N I3
- S LRSTFLG=1 W !,"How many shifts?"
- K DIR S DIR(0)="N^1:4:0"
- D ^DIR K DIR S LRNSFT=X I $D(DIRUT)!($D(DUOUT)) S LREND=1 Q
- F I3=1:1:LRNSFT D Q:LREND
- . W !!,"For Shift # ",I3
- . D QTR Q:LREND=1
- . S LRST(I3)=LRSTRT_"^"_LRSTOP
- Q
- QTR ;*** Query for a time range (in military format) ***
- W !,"Enter TIME RANGE in military format HHMM.SS (0.00 - 2400.00):"
- K DIR S DIR(0)="LO^0.00:2400.00",DIR("A")="START time: "
- D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S LREND=1 Q
- S LRSTRT=X S:+LRSTRT=0 LRSTRT=.01 I LRSTRT="" G QTR
- Q1 K DIR S DIR(0)="LO^0.00:2400.00",DIR("A")="STOP time: "
- D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S LREND=1 Q
- S LRSTOP=X I LRSTOP="" G Q1
- I LRSTOP<LRSTRT W !,"Stop time should be GREATER than start time" G QTR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRRP8A 3375 printed Feb 18, 2025@23:45:57 Page 2
- LRRP8A ;DALISC/TNN/J0 - WKLD STATS REPORT BY SHIFT ; 4/9/93
- +1 ;;5.2;LAB SERVICE;**63**;Sep 27, 1994
- +2 WRITE !!,"ENTRY POINT IS AT EN^LRRP8."
- HANG 3
- QUIT
- +3 ;
- ASK ;
- +1 DO INST
- if LREND
- QUIT
- +2 DO ACCAREA
- if LREND
- QUIT
- +3 DO DATES
- if LREND
- QUIT
- +4 DO CAPS
- if LREND
- QUIT
- +5 DO TIMES
- if LREND
- QUIT
- +6 DO REPTYP
- if LREND
- QUIT
- +7 DO DEVICE
- if LREND
- QUIT
- +8 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
- ACCAREA ;*** Query for accession areas ***
- +1 SET LRAA=0
- +2 KILL DIR,X,Y
- SET DIR(0)="S^Y:YES;N:NO"
- SET DIR("B")="NO"
- +3 SET DIR("A")="Do you want to select accession areas (YES or NO) "
- +4 SET DIR("?",1)="Enter 'NO' to include ALL accession areas."
- +5 SET DIR("?")="Enter 'YES' to limit report to one or more accession areas."
- +6 DO ^DIR
- +7 if Y="N"
- QUIT
- +8 IF ($DATA(DTOUT))!($DATA(DUOUT))
- SET LREND=1
- QUIT
- +9 KILL DIC
- SET DIC=68
- SET DIC(0)="AEMQZ"
- +10 FOR
- DO ^DIC
- if Y=-1
- QUIT
- Begin DoDot:1
- +11 SET LRAA=+Y
- SET LRAA(+Y)=$PIECE(Y(0),U,11)
- End DoDot:1
- +12 IF ($DATA(DTOUT))!($DATA(DUOUT))
- SET LREND=1
- QUIT
- +13 QUIT
- DATES ;*** Query for date ***
- +1 WRITE !,"DATE selection:"
- +2 KILL DIR,X,Y
- SET DIR(0)="S^1:A specific date;2:A range of dates"
- +3 DO ^DIR
- +4 IF $DATA(DIRUT)!($DATA(DUOUT))
- SET LREND=1
- QUIT
- +5 IF X=1
- DO QDT
- QUIT
- +6 DO DATE^LRCAPR1A
- if Y=-1
- SET LREND=1
- +7 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
- TIMES ;*** Query for type of time search ***
- +1 WRITE !,"TIME selection:"
- +2 KILL DIR
- SET DIR(0)="S^1:A time range;2:A set of shifts"
- +3 DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))
- SET LREND=1
- QUIT
- +4 IF X=2
- DO QST
- QUIT
- +5 DO QTR
- IF ($GET(LRSTRT)<0)!($GET(LRSTOP)<0)
- SET LREND=1
- +6 QUIT
- REPTYP ;*** Query for type of type of report ***
- +1 WRITE !,"REPORT selection:"
- +2 KILL DIR
- SET DIR(0)="S^1:Detail report;2:Summary report"
- +3 DO ^DIR
- +4 IF $DATA(DTOUT)!($DATA(DUOUT))
- SET LREND=1
- QUIT
- +5 SET LRRPT=+X
- +6 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^LRRP8"
- SET ZTDESC="LR WKLD SHIFT REPORT"
- +2 if $GET(LRAA)
- SET ZTSAVE("LRAA*")=""
- +3 DO ^%ZTLOAD
- DO ^%ZISC
- +4 if $GET(ZTSK)
- WRITE !!,"TASK ",ZTSK," QUEUED."
- HANG 3
- +5 QUIT
- QDT ;*** Query for a specific date ***
- +1 WRITE !
- +2 SET DIC="^LRO(64.1,"_LRIN_",1,"
- SET DIC(0)="AQENM"
- DO ^DIC
- +3 IF Y=-1
- SET LREND=1
- QUIT
- +4 SET (LRDATE,LRFR,LRTO)=+Y
- SET LRDR=1
- DO DD^%DT
- +5 SET LRDTH="For: "_Y
- +6 QUIT
- QST ;*** Query for shifts ***
- +1 NEW I3
- +2 SET LRSTFLG=1
- WRITE !,"How many shifts?"
- +3 KILL DIR
- SET DIR(0)="N^1:4:0"
- +4 DO ^DIR
- KILL DIR
- SET LRNSFT=X
- IF $DATA(DIRUT)!($DATA(DUOUT))
- SET LREND=1
- QUIT
- +5 FOR I3=1:1:LRNSFT
- Begin DoDot:1
- +6 WRITE !!,"For Shift # ",I3
- +7 DO QTR
- if LREND=1
- QUIT
- +8 SET LRST(I3)=LRSTRT_"^"_LRSTOP
- End DoDot:1
- if LREND
- QUIT
- +9 QUIT
- QTR ;*** Query for a time range (in military format) ***
- +1 WRITE !,"Enter TIME RANGE in military format HHMM.SS (0.00 - 2400.00):"
- +2 KILL DIR
- SET DIR(0)="LO^0.00:2400.00"
- SET DIR("A")="START time: "
- +3 DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))
- SET LREND=1
- QUIT
- +4 SET LRSTRT=X
- if +LRSTRT=0
- SET LRSTRT=.01
- IF LRSTRT=""
- GOTO QTR
- Q1 KILL DIR
- SET DIR(0)="LO^0.00:2400.00"
- SET DIR("A")="STOP time: "
- +1 DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))
- SET LREND=1
- QUIT
- +2 SET LRSTOP=X
- IF LRSTOP=""
- GOTO Q1
- +3 IF LRSTOP<LRSTRT
- WRITE !,"Stop time should be GREATER than start time"
- GOTO QTR
- +4 QUIT