- LRRSP ;SLC/RWF/BA - INTERIM REPORT FOR SELECTED TESTS AS ORDERED ;8/11/97
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;5.2;LAB SERVICE;**121,283**;Sep 27, 1994
- ;from option LRRSP
- BEGIN D:'$D(LRPARAM) ^LRPARAM S LREND=0 F S LRSTOP=0 K DFN,DIC D PAT Q:LREND
- END D ^LRRK
- Q
- PAT S (LRPG,LRPRTPG)=0 D ^LRDPA I LRDFN=-1 S LREND=1 Q
- I $O(^LR(LRDFN,0))="" W !,"NO LAB DATA ON THIS PATIENT!",$C(7) Q
- S LRTSCRN=0,LRONETST="",LRONESPC="",DIC="^LAB(60,",DIC(0)="AEMOQ",DIC("S")="I ""BO""[$P(^(0),U,3)",DIC("A")="Select ORDERED TEST: ANY//" D ^DIC S:Y>0 LRTSCRN=+Y,LRONETST=LRTSCRN S:$D(DUOUT)!$D(DTOUT) LREND=1 Q:LREND
- K DIC,LRCW S LREDT="T-7" D ^LRWU3 Q:LREND S LRSDT=LRSDT\1
- ASKPG S DIR(0)="Y",DIR("A")="Print address page",DIR("B")="NO"
- D ^DIR K DIR
- I Y S LRPRTPG=1
- S ZTRTN="DQ^LRRSP",%ZIS="MQ" D IO^LRWU
- Q
- DQ ;dequeued
- S:$D(ZTQUEUED) ZTREQ="@" U IO
- S LRFOUND=0,LRODT=LRSDT F D ORDER Q:LREND!LRSTOP S X1=LRODT,X2=-1 D C^%DTC S LRODT=X Q:LRODT<LREDT
- I 'LRFOUND W !,"No data found to print for - " S Y=LRSDT D DD^LRX W Y_" TO " S Y=LREDT D DD^LRX W $S($E(Y)'[9:Y,1:"END OF ON LINE RECORDS")
- D:LRPRTPG PLSPG^LRRP2
- W @IOF
- Q
- ORDER S LRORDER="",LRSN=0 F S LRSN=+$O(^LRO(69,LRODT,1,"AA",LRDFN,LRSN)) Q:LRSN<1 D SCREEN S:X LRORDER=LRORDER_LRSN_U
- D SET^LRRP
- Q
- SCREEN S X=0 I 'LRTSCRN S X=1 Q
- S T=0 F S T=$O(^LRO(69,LRODT,1,LRSN,2,T)) Q:T<1 I +^(T,0)=LRTSCRN,'$P(^(0),"^",11) S X=1 Q
- Q
- LRRSP ;SLC/RWF/BA - INTERIM REPORT FOR SELECTED TESTS AS ORDERED ;8/11/97
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**121,283**;Sep 27, 1994
- +3 ;from option LRRSP
- BEGIN IF '$DATA(LRPARAM)
- DO ^LRPARAM
- SET LREND=0
- FOR
- SET LRSTOP=0
- KILL DFN,DIC
- DO PAT
- IF LREND
- QUIT
- END DO ^LRRK
- +1 QUIT
- PAT SET (LRPG,LRPRTPG)=0
- DO ^LRDPA
- IF LRDFN=-1
- SET LREND=1
- QUIT
- +1 IF $ORDER(^LR(LRDFN,0))=""
- WRITE !,"NO LAB DATA ON THIS PATIENT!",$CHAR(7)
- QUIT
- +2 SET LRTSCRN=0
- SET LRONETST=""
- SET LRONESPC=""
- SET DIC="^LAB(60,"
- SET DIC(0)="AEMOQ"
- SET DIC("S")="I ""BO""[$P(^(0),U,3)"
- SET DIC("A")="Select ORDERED TEST: ANY//"
- DO ^DIC
- IF Y>0
- SET LRTSCRN=+Y
- SET LRONETST=LRTSCRN
- IF $DATA(DUOUT)!$DATA(DTOUT)
- SET LREND=1
- IF LREND
- QUIT
- +3 KILL DIC,LRCW
- SET LREDT="T-7"
- DO ^LRWU3
- IF LREND
- QUIT
- SET LRSDT=LRSDT\1
- ASKPG SET DIR(0)="Y"
- SET DIR("A")="Print address page"
- SET DIR("B")="NO"
- +1 DO ^DIR
- KILL DIR
- +2 IF Y
- SET LRPRTPG=1
- +3 SET ZTRTN="DQ^LRRSP"
- SET %ZIS="MQ"
- DO IO^LRWU
- +4 QUIT
- DQ ;dequeued
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- USE IO
- +2 SET LRFOUND=0
- SET LRODT=LRSDT
- FOR
- DO ORDER
- IF LREND!LRSTOP
- QUIT
- SET X1=LRODT
- SET X2=-1
- DO C^%DTC
- SET LRODT=X
- IF LRODT<LREDT
- QUIT
- +3 IF 'LRFOUND
- WRITE !,"No data found to print for - "
- SET Y=LRSDT
- DO DD^LRX
- WRITE Y_" TO "
- SET Y=LREDT
- DO DD^LRX
- WRITE $SELECT($EXTRACT(Y)'[9:Y,1:"END OF ON LINE RECORDS")
- +4 IF LRPRTPG
- DO PLSPG^LRRP2
- +5 WRITE @IOF
- +6 QUIT
- ORDER SET LRORDER=""
- SET LRSN=0
- FOR
- SET LRSN=+$ORDER(^LRO(69,LRODT,1,"AA",LRDFN,LRSN))
- IF LRSN<1
- QUIT
- DO SCREEN
- IF X
- SET LRORDER=LRORDER_LRSN_U
- +1 DO SET^LRRP
- +2 QUIT
- SCREEN SET X=0
- IF 'LRTSCRN
- SET X=1
- QUIT
- +1 SET T=0
- FOR
- SET T=$ORDER(^LRO(69,LRODT,1,LRSN,2,T))
- IF T<1
- QUIT
- IF +^(T,0)=LRTSCRN
- IF '$PIECE(^(0),"^",11)
- SET X=1
- QUIT
- +2 QUIT
