LRRSP.m

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