LRRSP ;DALOI/RWF/BA - INTERIM REPORT FOR SELECTED TESTS AS ORDERED ;11/18/11 16:42
;;5.2;LAB SERVICE;**121,283,350**;Sep 27, 1994;Build 230
;
; 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")
I LRFOUND,LRPRTPG D 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRRSP 1466 printed Apr 09, 2024@21:25:15 Page 2
LRRSP ;DALOI/RWF/BA - INTERIM REPORT FOR SELECTED TESTS AS ORDERED ;11/18/11 16:42
+1 ;;5.2;LAB SERVICE;**121,283,350**;Sep 27, 1994;Build 230
+2 ;
+3 ; from option LRRSP
+4 ;
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
+2 ;
+3 ;
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
+4 ;
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
+5 ;
+6 ;
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 LRFOUND
IF LRPRTPG
DO PLSPG^LRRP2
+5 WRITE @IOF
+6 QUIT
+7 ;
+8 ;
ORDER ;
+1 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
+2 DO SET^LRRP
+3 QUIT
+4 ;
+5 ;
SCREEN ;
+1 SET X=0
IF 'LRTSCRN
SET X=1
QUIT
+2 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
+3 QUIT
