LRLISTPS.m

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 ---LRLISTPS   3840     printed  Mar 13, 2025@21:20:32                                                                                                                                                                                                    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