LRLISTPS ;JMC/DALOI Print patient LAB DATA file Summary ;09/16/15 17:12
;;5.2;LAB SERVICE;**458**;Sep 27, 1994;Build 10
;
; ZEXCEPT is used to identify variables which are external to a specific TAG
; used in conjunction with Eclipse M-editor.
;
;
EN ; Print summary report based only on entry in file #63.
;
N %ZIS,DA,DIC,DIR,DIRUT,DR,DX,IOP,LRDFN,LREDAT,LREDT,LREND,LRIDT,LRIDTE,LRIDTS,LRLONG,LRRAW,LRSDAT,LRSDT,LRSS,POP,X,Y
;
D EN^LRPARAM
D ^LRDPA Q:LRDFN<1
;
S DIR(0)="SAO^CH:CHEM, HEM, TOX, RIA, SER, etc.;MI:MICROBIOLOGY;EM:ELECTRON MICROSCOPY;SP:SURGICAL PATHOLOGY;CY:CYTOLOGY;BB:BLOOD BANK"
S DIR("A")="Select LR SUBSCRIPT: ",DIR("B")="CH"
D ^DIR
I $D(DIRUT) Q
S LRSS=Y,LRSS(0)=Y(0)
;
S (LREND,LRRAW)=0,LRLONG=1
;
S LRSDT=$$STARTDT()
I 'LRSDT S LREND=1 Q
S LREDT=$$ENDDT(.LRSDT)
I 'LREDT S LREND=1 Q
S LRSDAT=$$FMTE^XLFDT(LRSDT,"1Z"),LREDAT=$$FMTE^XLFDT(LREDT,"1Z")
;
I LRSS="CH" D Q:$D(DIRUT)
. K DIR
. S DIR(0)="YO",DIR("A")="Display an Extended Listing",DIR("B")="YES"
. S DIR("?")="Extended provides result's demographics and normal ranges."
. D ^DIR
. I $D(DIRUT) Q
. I Y S LRLONG=2
;
K DIR
S DIR(0)="YO",DIR("A")="Display associated global",DIR("B")="NO"
S DIR("?")="Lists related global entry from file #63 where results are stored."
D ^DIR
I $D(DIRUT) Q
I Y S LRRAW=1
;
S %ZIS="MQ" D ^%ZIS
I POP D HOME^%ZIS Q
I $D(IO("Q")) D Q
. N ZTDESC,ZTRTN,ZTSAVE,ZTSK
. S ZTRTN="DQP^LLISTPS",ZTSAVE("LR*")="",ZTDESC="Print Lab Patient Summary Report"
. D ^%ZTLOAD,^%ZISC
. D EN^DDIOL("Request "_$S($G(ZTSK):"queued - Task #"_ZTSK,1:"NOT queued"),"","!")
;
;
DQP ; Dequeue (TaskMan ) entry point and from above
;
U IO
I $E(IOST,1,2)'="P-" W @IOF
D HEAD
;
S DIC="^LR("_LRDFN_","""_LRSS_""","
S (LRIDT,LRIDTE)=9999999-LRSDT,LRIDTS=9999999-LREDT
F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:LRIDT<1!(LRIDT>LRIDTS) D Q:LREND
. S DA=LRIDT,DR="0:9999999"
. K DX W ! D EN^LRDIQ
. I $D(DIRUT) S LREND=1 Q
. S DR="ORU:RF" D EN^LRDIQ
. I $D(DIRUT) S LREND=1 Q
. D WAIT
. I LRRAW=1 D LRRAW(LRDFN,LRSS,LRIDT)
;
D CLEAN
Q
;
;
LRRAW(LRDFN,LRSS,LRIDT) ; Display raw data from LR global.
;
N LRNODE,LRQUIT,LRROOT
;
W !!,"Related LAB DATA file (#63) global listing",!
;
S LRROOT=$NA(^LR(LRDFN,LRSS,LRIDT))
S LRNODE=LRROOT,LRQUIT=0
F S LRNODE=$Q(@LRNODE) Q:LRNODE="" D Q:LRQUIT
. I $QS(LRNODE,1)=LRDFN,$QS(LRNODE,2)=LRSS,$QS(LRNODE,3)=LRIDT W !,LRNODE," = ",@LRNODE
. E S LRQUIT=1
;
Q
;
;
WAIT ; Check if continue display
;
;ZEXCEPT: LREND
;
I '$D(ZTQUEUED),$E(IOST,1,2)="C-" D Q:LREND
. N DIR,DIRUT,DTOUT,DUOUT,X,Y
. S DIR(0)="E" D ^DIR
. I Y'=1 S LREND=1
;
I ($Y+2)>IOSL D HEAD
Q
;
;
HEAD ; Print header
;ZEXCEPT: LREDAT,LRSDAT,LRSS,PNM,SEX,SSN
;
I $E(IOST,1,2)="P-" W @IOF
W !,"Patient Summary Report",?25,"WORK COPY ONLY - DO NOT FILE",?58,"Printed: ",$$FMTE^XLFDT(DT,"1Z")
W !,PNM,?30,SSN,?45," Sex: ",SEX
W !," For date range: "_LREDAT_" to "_LRSDAT_" for "_LRSS(0)
Q
;
;
CLEAN ; Clean up and quit
I $E(IOST,1,2)'="C-" W @IOF
I '$D(ZTQUEUED) D ^%ZISC
E S ZTREQ="@"
;
D KVA^VADPT
Q
;
;
STARTDT() ; Prompt for start date/time
;
N LRSDT
;
S LRSDT=$$DATE("Enter START date: ","TODAY","AET")
Q LRSDT
;
;
ENDDT(LRSDT) ; Prompt for end date/time
;
; LRSDT - Start Date/Time (Passed by reference)
;
N LREDT,X
;
S LREDT=$$DATE("Enter END date: ","T-1","AET")
I 'LREDT Q 0
;
I $G(LRSDT)="" Q
;
I LREDT>LRSDT D
. S X=LREDT
. S LREDT=LRSDT
. S LRSDT=X
;
I '$P(LRSDT,".",2) S LRSDT=LRSDT+.24
;
Q LREDT
;
;
DATE(LRPROMPT,LRDEFAULT,LRFLAGS) ;
;
N %DT,DTOUT,X,Y
;
S %DT("A")=LRPROMPT
S %DT("B")=LRDEFAULT
S %DT=LRFLAGS
D ^%DT
I Y<0 Q 0
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLISTPS 3840 printed Sep 23, 2025@19:51:52 Page 2
LRLISTPS ;JMC/DALOI Print patient LAB DATA file Summary ;09/16/15 17:12
+1 ;;5.2;LAB SERVICE;**458**;Sep 27, 1994;Build 10
+2 ;
+3 ; ZEXCEPT is used to identify variables which are external to a specific TAG
+4 ; used in conjunction with Eclipse M-editor.
+5 ;
+6 ;
EN ; Print summary report based only on entry in file #63.
+1 ;
+2 NEW %ZIS,DA,DIC,DIR,DIRUT,DR,DX,IOP,LRDFN,LREDAT,LREDT,LREND,LRIDT,LRIDTE,LRIDTS,LRLONG,LRRAW,LRSDAT,LRSDT,LRSS,POP,X,Y
+3 ;
+4 DO EN^LRPARAM
+5 DO ^LRDPA
if LRDFN<1
QUIT
+6 ;
+7 SET DIR(0)="SAO^CH:CHEM, HEM, TOX, RIA, SER, etc.;MI:MICROBIOLOGY;EM:ELECTRON MICROSCOPY;SP:SURGICAL PATHOLOGY;CY:CYTOLOGY;BB:BLOOD BANK"
+8 SET DIR("A")="Select LR SUBSCRIPT: "
SET DIR("B")="CH"
+9 DO ^DIR
+10 IF $DATA(DIRUT)
QUIT
+11 SET LRSS=Y
SET LRSS(0)=Y(0)
+12 ;
+13 SET (LREND,LRRAW)=0
SET LRLONG=1
+14 ;
+15 SET LRSDT=$$STARTDT()
+16 IF 'LRSDT
SET LREND=1
QUIT
+17 SET LREDT=$$ENDDT(.LRSDT)
+18 IF 'LREDT
SET LREND=1
QUIT
+19 SET LRSDAT=$$FMTE^XLFDT(LRSDT,"1Z")
SET LREDAT=$$FMTE^XLFDT(LREDT,"1Z")
+20 ;
+21 IF LRSS="CH"
Begin DoDot:1
+22 KILL DIR
+23 SET DIR(0)="YO"
SET DIR("A")="Display an Extended Listing"
SET DIR("B")="YES"
+24 SET DIR("?")="Extended provides result's demographics and normal ranges."
+25 DO ^DIR
+26 IF $DATA(DIRUT)
QUIT
+27 IF Y
SET LRLONG=2
End DoDot:1
if $DATA(DIRUT)
QUIT
+28 ;
+29 KILL DIR
+30 SET DIR(0)="YO"
SET DIR("A")="Display associated global"
SET DIR("B")="NO"
+31 SET DIR("?")="Lists related global entry from file #63 where results are stored."
+32 DO ^DIR
+33 IF $DATA(DIRUT)
QUIT
+34 IF Y
SET LRRAW=1
+35 ;
+36 SET %ZIS="MQ"
DO ^%ZIS
+37 IF POP
DO HOME^%ZIS
QUIT
+38 IF $DATA(IO("Q"))
Begin DoDot:1
+39 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+40 SET ZTRTN="DQP^LLISTPS"
SET ZTSAVE("LR*")=""
SET ZTDESC="Print Lab Patient Summary Report"
+41 DO ^%ZTLOAD
DO ^%ZISC
+42 DO EN^DDIOL("Request "_$SELECT($GET(ZTSK):"queued - Task #"_ZTSK,1:"NOT queued"),"","!")
End DoDot:1
QUIT
+43 ;
+44 ;
DQP ; Dequeue (TaskMan ) entry point and from above
+1 ;
+2 USE IO
+3 IF $EXTRACT(IOST,1,2)'="P-"
WRITE @IOF
+4 DO HEAD
+5 ;
+6 SET DIC="^LR("_LRDFN_","""_LRSS_""","
+7 SET (LRIDT,LRIDTE)=9999999-LRSDT
SET LRIDTS=9999999-LREDT
+8 FOR
SET LRIDT=$ORDER(^LR(LRDFN,LRSS,LRIDT))
if LRIDT<1!(LRIDT>LRIDTS)
QUIT
Begin DoDot:1
+9 SET DA=LRIDT
SET DR="0:9999999"
+10 KILL DX
WRITE !
DO EN^LRDIQ
+11 IF $DATA(DIRUT)
SET LREND=1
QUIT
+12 SET DR="ORU:RF"
DO EN^LRDIQ
+13 IF $DATA(DIRUT)
SET LREND=1
QUIT
+14 DO WAIT
+15 IF LRRAW=1
DO LRRAW(LRDFN,LRSS,LRIDT)
End DoDot:1
if LREND
QUIT
+16 ;
+17 DO CLEAN
+18 QUIT
+19 ;
+20 ;
LRRAW(LRDFN,LRSS,LRIDT) ; Display raw data from LR global.
+1 ;
+2 NEW LRNODE,LRQUIT,LRROOT
+3 ;
+4 WRITE !!,"Related LAB DATA file (#63) global listing",!
+5 ;
+6 SET LRROOT=$NAME(^LR(LRDFN,LRSS,LRIDT))
+7 SET LRNODE=LRROOT
SET LRQUIT=0
+8 FOR
SET LRNODE=$QUERY(@LRNODE)
if LRNODE=""
QUIT
Begin DoDot:1
+9 IF $QSUBSCRIPT(LRNODE,1)=LRDFN
IF $QSUBSCRIPT(LRNODE,2)=LRSS
IF $QSUBSCRIPT(LRNODE,3)=LRIDT
WRITE !,LRNODE," = ",@LRNODE
+10 IF '$TEST
SET LRQUIT=1
End DoDot:1
if LRQUIT
QUIT
+11 ;
+12 QUIT
+13 ;
+14 ;
WAIT ; Check if continue display
+1 ;
+2 ;ZEXCEPT: LREND
+3 ;
+4 IF '$DATA(ZTQUEUED)
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+5 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+6 SET DIR(0)="E"
DO ^DIR
+7 IF Y'=1
SET LREND=1
End DoDot:1
if LREND
QUIT
+8 ;
+9 IF ($Y+2)>IOSL
DO HEAD
+10 QUIT
+11 ;
+12 ;
HEAD ; Print header
+1 ;ZEXCEPT: LREDAT,LRSDAT,LRSS,PNM,SEX,SSN
+2 ;
+3 IF $EXTRACT(IOST,1,2)="P-"
WRITE @IOF
+4 WRITE !,"Patient Summary Report",?25,"WORK COPY ONLY - DO NOT FILE",?58,"Printed: ",$$FMTE^XLFDT(DT,"1Z")
+5 WRITE !,PNM,?30,SSN,?45," Sex: ",SEX
+6 WRITE !," For date range: "_LREDAT_" to "_LRSDAT_" for "_LRSS(0)
+7 QUIT
+8 ;
+9 ;
CLEAN ; Clean up and quit
+1 IF $EXTRACT(IOST,1,2)'="C-"
WRITE @IOF
+2 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+3 IF '$TEST
SET ZTREQ="@"
+4 ;
+5 DO KVA^VADPT
+6 QUIT
+7 ;
+8 ;
STARTDT() ; Prompt for start date/time
+1 ;
+2 NEW LRSDT
+3 ;
+4 SET LRSDT=$$DATE("Enter START date: ","TODAY","AET")
+5 QUIT LRSDT
+6 ;
+7 ;
ENDDT(LRSDT) ; Prompt for end date/time
+1 ;
+2 ; LRSDT - Start Date/Time (Passed by reference)
+3 ;
+4 NEW LREDT,X
+5 ;
+6 SET LREDT=$$DATE("Enter END date: ","T-1","AET")
+7 IF 'LREDT
QUIT 0
+8 ;
+9 IF $GET(LRSDT)=""
QUIT
+10 ;
+11 IF LREDT>LRSDT
Begin DoDot:1
+12 SET X=LREDT
+13 SET LREDT=LRSDT
+14 SET LRSDT=X
End DoDot:1
+15 ;
+16 IF '$PIECE(LRSDT,".",2)
SET LRSDT=LRSDT+.24
+17 ;
+18 QUIT LREDT
+19 ;
+20 ;
DATE(LRPROMPT,LRDEFAULT,LRFLAGS) ;
+1 ;
+2 NEW %DT,DTOUT,X,Y
+3 ;
+4 SET %DT("A")=LRPROMPT
+5 SET %DT("B")=LRDEFAULT
+6 SET %DT=LRFLAGS
+7 DO ^%DT
+8 IF Y<0
QUIT 0
+9 QUIT Y
