- LRARCR1 ;DALISC/CKA - ARCHIVED WKLD REP GENERATOR-MAIN ;
- ;;5.2;LAB SERVICE;**59**;August 31, 1995
- GO ;
- G TRIAL
- EN ;
- K DIC,%DT,^TMP("LRAR",$J),LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC
- K LRSITSEL,DIR
- S (LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC,LREND)=0
- S LRIOPAT=""
- Q
- LRINST ;
- S LRSITNUM=+$P($G(^XMB(1,1,"XUS")),U,17)
- S LRSITE=$P($G(^DIC(4,LRSITNUM,0)),U) S:LRSITE="" LRSITE="UNKNOWN"
- S LRSITSEL=0 K DIR S DIR(0)="S^Y:YES;N:NO"
- S DIR("A")="Do you want to print a specific DIVISION?"
- S DIR("?")="If you have a multi-divisional institution you might want to print a particular division, otherwise your report will reflect the whole instution which might not be what you have intended."
- D ^DIR Q:$D(DUOUT)!($D(DTOUT))
- I Y="N" Q
- S DIC("A")="Select a Division:",DIC=4,DIC(0)="AEMQ"
- F D ^DIC Q:Y=-1 S LRSITSEL=+Y,LRSITSEL(+Y)=$S($L($P($G(^DIC(4,+Y,0)),U)):$P(^(0),U),1:"ERROR"_Y)
- Q
- TRIAL ; entry point for work load lookup
- D EN,LRINST G:$D(DUOUT)!($D(DTOUT)) EXIT K DIR
- D ACCN^LRARCR1A G:Y<0 EXIT
- D DATE^LRARCR1A G:Y<0 EXIT S %=2
- W !,"Do you want to look up by Specimen Type and/or Collection Sample"
- D YN^DICN G:%<0 EXIT G:%=2 A
- S DIR(0)="S^S:SPECIMEN TYPE;C:COLLECTION SAMPLE;B:BOTH;A:ALL or ANY (Will not prompt)"
- S DIR("?")="<All> will not prompt for a specimen or sample"
- D ^DIR G:$D(DUOUT)!($D(DTOUT)) EXIT G @Y
- B D SPEC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
- C D COLL^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G A
- S D SPEC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
- A W !,"Do you want to select by TESTS or WKLD CODES (YES or NO )"
- S %=2 D YN^DICN G:%=-1 EXIT
- G:%=2 I D ASK G:$D(DUOUT)!($D(DTOUT)) EXIT K DIC,DIR
- I Y="A" G L
- I Y="W" D CAP^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G L
- D TEST^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
- I D INSTR^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
- L ;
- D STAT^LRARCR1A G:$D(DUOUT)!($D(DTOUT))!(%<0) EXIT
- D LOC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
- D IOPAT^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
- D CONTROL^LRARCR1A G:LREND EXIT
- D REPTYP^LRARCR1A G:LREND EXIT
- K DIR S DIR(0)="SX^D:DETAILED;C:CONDENSED",DIR("A")=" REPORT"
- D ^DIR G:$D(DUOUT)!($D(DTOUT)) EXIT S LRANS=Y K DIR
- K IO("Q") S %ZIS="Q" D ^%ZIS G:POP EXIT I $D(IO("Q")) G QUE
- D WAIT^DICD
- U IO D ^LRARCR2
- Q
- ASK ;
- S DIR(0)="S^T:TEST;W:WKLD CODE;A:ALL (means no specific TEST or WKLD CODE )",DIR("A")="Do you want to select by (T)est or (W)KLD Code or (A)ll"
- S DIR("?")="All means no specified TEST or WKLD code is desired and will take you to the next prompt."
- S DIR("?",1)="You can only select either by TESTs or by WKLD CODEs"
- S DIR("?",2)="Choosing ALL will take you to the location prompt right away."
- S DIR("?",3)="Selecting by WLKD codes will limit you to a particular test only,"
- S DIR("?",4)="whereas by TEST might give you 1 or more WKLD codes."
- D ^DIR
- Q
- QUE ;
- S ZTSAVE("LR*")="",ZTRTN="LRARCR2",ZTDESC="ARCHIVED WORKLOAD REPORT",ZTIO=ION
- S:$G(LRSITE) ZTSAVE("LRSITE*")=""
- S:$G(LRSP) ZTSAVE("LRSP*")="" S:$G(LRCOL) ZTSAVE("LRCOL*")=""
- S:$G(LRTST) ZTSAVE("LRTST*")="" S:$G(LRCAPS) ZTSAVE("LRCAPS*")=""
- S:$G(LRCPSX) ZTSAVE("LRCPSX*")="" S:$G(LRLOC) ZTSAVE("LRLOC*")=""
- D ^%ZTLOAD,^%ZISC
- S LREND=1
- EXIT ;
- S LREND=1
- D CLEAN^LRARCR4
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARCR1 3241 printed Jan 18, 2025@03:09:59 Page 2
- LRARCR1 ;DALISC/CKA - ARCHIVED WKLD REP GENERATOR-MAIN ;
- +1 ;;5.2;LAB SERVICE;**59**;August 31, 1995
- GO ;
- +1 GOTO TRIAL
- EN ;
- +1 KILL DIC,%DT,^TMP("LRAR",$JOB),LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC
- +2 KILL LRSITSEL,DIR
- +3 SET (LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC,LREND)=0
- +4 SET LRIOPAT=""
- +5 QUIT
- LRINST ;
- +1 SET LRSITNUM=+$PIECE($GET(^XMB(1,1,"XUS")),U,17)
- +2 SET LRSITE=$PIECE($GET(^DIC(4,LRSITNUM,0)),U)
- if LRSITE=""
- SET LRSITE="UNKNOWN"
- +3 SET LRSITSEL=0
- KILL DIR
- SET DIR(0)="S^Y:YES;N:NO"
- +4 SET DIR("A")="Do you want to print a specific DIVISION?"
- +5 SET DIR("?")="If you have a multi-divisional institution you might want to print a particular division, otherwise your report will reflect the whole instution which might not be what you have intended."
- +6 DO ^DIR
- if $DATA(DUOUT)!($DATA(DTOUT))
- QUIT
- +7 IF Y="N"
- QUIT
- +8 SET DIC("A")="Select a Division:"
- SET DIC=4
- SET DIC(0)="AEMQ"
- +9 FOR
- DO ^DIC
- if Y=-1
- QUIT
- SET LRSITSEL=+Y
- SET LRSITSEL(+Y)=$SELECT($LENGTH($PIECE($GET(^DIC(4,+Y,0)),U)):$PIECE(^(0),U),1:"ERROR"_Y)
- +10 QUIT
- TRIAL ; entry point for work load lookup
- +1 DO EN
- DO LRINST
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- KILL DIR
- +2 DO ACCN^LRARCR1A
- if Y<0
- GOTO EXIT
- +3 DO DATE^LRARCR1A
- if Y<0
- GOTO EXIT
- SET %=2
- +4 WRITE !,"Do you want to look up by Specimen Type and/or Collection Sample"
- +5 DO YN^DICN
- if %<0
- GOTO EXIT
- if %=2
- GOTO A
- +6 SET DIR(0)="S^S:SPECIMEN TYPE;C:COLLECTION SAMPLE;B:BOTH;A:ALL or ANY (Will not prompt)"
- +7 SET DIR("?")="<All> will not prompt for a specimen or sample"
- +8 DO ^DIR
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- GOTO @Y
- B DO SPEC^LRARCR1A
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- C DO COLL^LRARCR1A
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- GOTO A
- S DO SPEC^LRARCR1A
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- A WRITE !,"Do you want to select by TESTS or WKLD CODES (YES or NO )"
- +1 SET %=2
- DO YN^DICN
- if %=-1
- GOTO EXIT
- +2 if %=2
- GOTO I
- DO ASK
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- KILL DIC,DIR
- +3 IF Y="A"
- GOTO L
- +4 IF Y="W"
- DO CAP^LRARCR1A
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- GOTO L
- +5 DO TEST^LRARCR1A
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- I DO INSTR^LRARCR1A
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- L ;
- +1 DO STAT^LRARCR1A
- if $DATA(DUOUT)!($DATA(DTOUT))!(%<0)
- GOTO EXIT
- +2 DO LOC^LRARCR1A
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- +3 DO IOPAT^LRARCR1A
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- +4 DO CONTROL^LRARCR1A
- if LREND
- GOTO EXIT
- +5 DO REPTYP^LRARCR1A
- if LREND
- GOTO EXIT
- +6 KILL DIR
- SET DIR(0)="SX^D:DETAILED;C:CONDENSED"
- SET DIR("A")=" REPORT"
- +7 DO ^DIR
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO EXIT
- SET LRANS=Y
- KILL DIR
- +8 KILL IO("Q")
- SET %ZIS="Q"
- DO ^%ZIS
- if POP
- GOTO EXIT
- IF $DATA(IO("Q"))
- GOTO QUE
- +9 DO WAIT^DICD
- +10 USE IO
- DO ^LRARCR2
- +11 QUIT
- ASK ;
- +1 SET DIR(0)="S^T:TEST;W:WKLD CODE;A:ALL (means no specific TEST or WKLD CODE )"
- SET DIR("A")="Do you want to select by (T)est or (W)KLD Code or (A)ll"
- +2 SET DIR("?")="All means no specified TEST or WKLD code is desired and will take you to the next prompt."
- +3 SET DIR("?",1)="You can only select either by TESTs or by WKLD CODEs"
- +4 SET DIR("?",2)="Choosing ALL will take you to the location prompt right away."
- +5 SET DIR("?",3)="Selecting by WLKD codes will limit you to a particular test only,"
- +6 SET DIR("?",4)="whereas by TEST might give you 1 or more WKLD codes."
- +7 DO ^DIR
- +8 QUIT
- QUE ;
- +1 SET ZTSAVE("LR*")=""
- SET ZTRTN="LRARCR2"
- SET ZTDESC="ARCHIVED WORKLOAD REPORT"
- SET ZTIO=ION
- +2 if $GET(LRSITE)
- SET ZTSAVE("LRSITE*")=""
- +3 if $GET(LRSP)
- SET ZTSAVE("LRSP*")=""
- if $GET(LRCOL)
- SET ZTSAVE("LRCOL*")=""
- +4 if $GET(LRTST)
- SET ZTSAVE("LRTST*")=""
- if $GET(LRCAPS)
- SET ZTSAVE("LRCAPS*")=""
- +5 if $GET(LRCPSX)
- SET ZTSAVE("LRCPSX*")=""
- if $GET(LRLOC)
- SET ZTSAVE("LRLOC*")=""
- +6 DO ^%ZTLOAD
- DO ^%ZISC
- +7 SET LREND=1
- EXIT ;
- +1 SET LREND=1
- +2 DO CLEAN^LRARCR4
- +3 QUIT