- LRRS13 ; IHS/DIR/FJE - INTERIM REPORT BY LOCATION (MANUAL QUEUE) 2/19/91 11:39 ;
- ;;5.2;LR;**1013**;JUL 15, 2002
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- ;EXTENSION OF LRRS12
- DQ ;dequeued
- S LRHOLD=LRODT
- S:$D(ZTQUEUED) ZTREQ="@" U IO D @$S(LRLOC="S":"IT",LRLOC="R":"IT",1:"ALL")
- END ;
- D ^LRRK
- K LRLOCXY,LRX1,LRY1,OK
- Q
- CHKDAT ;
- S LRHOLD=LRODT
- S LRCHK=""
- F S LRODT=$O(^LRO(69,LRODT)) Q:LRODT=""!(LRODT>LRLAST) D
- . I $O(^LRO(69,LRODT,1,"AL",LRCHK))="" D NORPT
- S LRODT=LRHOLD K LRHOLD
- Q
- IT ;
- S LRHOLD=LRODT
- S LRLLOC=""
- F S LRLLOC=$O(LRLLOC(LRLLOC)) Q:LRLLOC=""!($G(LREND)) D
- . S LRODT=LRDTXX-.5
- . D BIG
- . S LRANY=0
- . F S LRODT=$O(^LRO(69,LRODT)) Q:LRODT=""!(LRODT>LRLAST)!($G(LREND)) D
- .. I $D(^LRO(69,LRODT,1,"AL",LRLLOC)) D PROCESS S LRANY=1
- . I '$G(LRANY) D NORPT QUIT
- Q
- NORPT ;
- W !!!
- W !?10,"No Reports from: ",LRLLOC," for this date range."
- W @IOF
- Q
- ALL ;
- S LREND=0
- S LRODT=LRDTXX-.5
- F S LRODT=$O(^LRO(69,LRODT)) Q:+LRODT'>0!(LRODT>LRLAST)!($G(LREND)) D
- . S LRLLOC="",LRANY=0
- . F S LRLLOC=$O(^LRO(69,LRODT,1,"AL",LRLLOC)) Q:LRLLOC=""!($G(LREND)) D
- .. D BIG,PROCESS S LRANY=1
- Q:LRLLOC="" I '$G(LRANY) D NORPT QUIT
- Q
- BIG ;
- ;Q:$G(LRANY)
- S LRXY98Z=1
- S LRLTR=$S(LRLLOC="":"UNK",1:LRLLOC)
- W !!
- I $E(IOST,1,2)'="C-" D ^LRLTR
- ;D ^LRLTR W @IOF
- K LRXY98Z
- Q
- PROCESS ;
- S LREDT=9999999-LRODT,LRSDT=LRODT+.5
- S LRJ0=1
- D LNAME
- Q:LREND
- K LRHOLD
- Q
- LNAME ;
- Q:$G(LREND)
- S LRNAME=""
- F S LRNAME=$O(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME)) Q:LRNAME=""!($G(LREND)) D
- . D PAT Q:LREND
- Q
- PAT ;
- Q:$G(LREND)
- S LRDFN=0
- F S LRDFN=+$O(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME,LRDFN)) Q:LRDFN<1!($G(LREND)) D
- . S LRIDT=9999999-LRSDT D DS^LRRP2 S:LRSTOP LREND=1 Q:$G(LREND)
- Q
- SINGLE ;from option LRRS BY LOC
- S LRSINGLE=1,LRLOC="S" D BEGIN^LRRS12
- Q
- SHOW ;Display possible choices of locations
- W !?10,"Select from: " S I="",LREND=0 F A=0:0 S I=$O(^LRO(69,LRODT,1,"AL",I)) Q:I="" D:$Y>(IOSL-4) WAIT Q:LREND W ?25,I,!
- K A S (LROK,LREND)=0 W ! Q
- WAIT R !!?10,"Press RETURN to continue or '^' to exit: ",X:DTIME S:'$T!($E(X)="^") LREND=1 Q:LREND
- W @IOF,!!?10,"Select from: " Q
- LRRS13 ; IHS/DIR/FJE - INTERIM REPORT BY LOCATION (MANUAL QUEUE) 2/19/91 11:39 ;
- +1 ;;5.2;LR;**1013**;JUL 15, 2002
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 ;EXTENSION OF LRRS12
- DQ ;dequeued
- +1 SET LRHOLD=LRODT
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- USE IO
- DO @$SELECT(LRLOC="S":"IT",LRLOC="R":"IT",1:"ALL")
- END ;
- +1 DO ^LRRK
- +2 KILL LRLOCXY,LRX1,LRY1,OK
- +3 QUIT
- CHKDAT ;
- +1 SET LRHOLD=LRODT
- +2 SET LRCHK=""
- +3 FOR
- SET LRODT=$ORDER(^LRO(69,LRODT))
- IF LRODT=""!(LRODT>LRLAST)
- QUIT
- Begin DoDot:1
- +4 IF $ORDER(^LRO(69,LRODT,1,"AL",LRCHK))=""
- DO NORPT
- End DoDot:1
- +5 SET LRODT=LRHOLD
- KILL LRHOLD
- +6 QUIT
- IT ;
- +1 SET LRHOLD=LRODT
- +2 SET LRLLOC=""
- +3 FOR
- SET LRLLOC=$ORDER(LRLLOC(LRLLOC))
- IF LRLLOC=""!($GET(LREND))
- QUIT
- Begin DoDot:1
- +4 SET LRODT=LRDTXX-.5
- +5 DO BIG
- +6 SET LRANY=0
- +7 FOR
- SET LRODT=$ORDER(^LRO(69,LRODT))
- IF LRODT=""!(LRODT>LRLAST)!($GET(LREND))
- QUIT
- Begin DoDot:2
- +8 IF $DATA(^LRO(69,LRODT,1,"AL",LRLLOC))
- DO PROCESS
- SET LRANY=1
- End DoDot:2
- +9 IF '$GET(LRANY)
- DO NORPT
- QUIT
- End DoDot:1
- +10 QUIT
- NORPT ;
- +1 WRITE !!!
- +2 WRITE !?10,"No Reports from: ",LRLLOC," for this date range."
- +3 WRITE @IOF
- +4 QUIT
- ALL ;
- +1 SET LREND=0
- +2 SET LRODT=LRDTXX-.5
- +3 FOR
- SET LRODT=$ORDER(^LRO(69,LRODT))
- IF +LRODT'>0!(LRODT>LRLAST)!($GET(LREND))
- QUIT
- Begin DoDot:1
- +4 SET LRLLOC=""
- SET LRANY=0
- +5 FOR
- SET LRLLOC=$ORDER(^LRO(69,LRODT,1,"AL",LRLLOC))
- IF LRLLOC=""!($GET(LREND))
- QUIT
- Begin DoDot:2
- +6 DO BIG
- DO PROCESS
- SET LRANY=1
- End DoDot:2
- End DoDot:1
- +7 IF LRLLOC=""
- QUIT
- IF '$GET(LRANY)
- DO NORPT
- QUIT
- +8 QUIT
- BIG ;
- +1 ;Q:$G(LRANY)
- +2 SET LRXY98Z=1
- +3 SET LRLTR=$SELECT(LRLLOC="":"UNK",1:LRLLOC)
- +4 WRITE !!
- +5 IF $EXTRACT(IOST,1,2)'="C-"
- DO ^LRLTR
- +6 ;D ^LRLTR W @IOF
- +7 KILL LRXY98Z
- +8 QUIT
- PROCESS ;
- +1 SET LREDT=9999999-LRODT
- SET LRSDT=LRODT+.5
- +2 SET LRJ0=1
- +3 DO LNAME
- +4 IF LREND
- QUIT
- +5 KILL LRHOLD
- +6 QUIT
- LNAME ;
- +1 IF $GET(LREND)
- QUIT
- +2 SET LRNAME=""
- +3 FOR
- SET LRNAME=$ORDER(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME))
- IF LRNAME=""!($GET(LREND))
- QUIT
- Begin DoDot:1
- +4 DO PAT
- IF LREND
- QUIT
- End DoDot:1
- +5 QUIT
- PAT ;
- +1 IF $GET(LREND)
- QUIT
- +2 SET LRDFN=0
- +3 FOR
- SET LRDFN=+$ORDER(^LRO(69,LRODT,1,"AL",LRLLOC,LRNAME,LRDFN))
- IF LRDFN<1!($GET(LREND))
- QUIT
- Begin DoDot:1
- +4 SET LRIDT=9999999-LRSDT
- DO DS^LRRP2
- IF LRSTOP
- SET LREND=1
- IF $GET(LREND)
- QUIT
- End DoDot:1
- +5 QUIT
- SINGLE ;from option LRRS BY LOC
- +1 SET LRSINGLE=1
- SET LRLOC="S"
- DO BEGIN^LRRS12
- +2 QUIT
- SHOW ;Display possible choices of locations
- +1 WRITE !?10,"Select from: "
- SET I=""
- SET LREND=0
- FOR A=0:0
- SET I=$ORDER(^LRO(69,LRODT,1,"AL",I))
- IF I=""
- QUIT
- IF $Y>(IOSL-4)
- DO WAIT
- IF LREND
- QUIT
- WRITE ?25,I,!
- +2 KILL A
- SET (LROK,LREND)=0
- WRITE !
- QUIT
- WAIT READ !!?10,"Press RETURN to continue or '^' to exit: ",X:DTIME
- IF '$TEST!($EXTRACT(X)="^")
- SET LREND=1
- IF LREND
- QUIT
- +1 WRITE @IOF,!!?10,"Select from: "
- QUIT
