BLRSORA ;VA/DRH/DALISC - HIGH/LOW VALUE TASKED REPORT ;2/19/91 11:42 ;
;;5.2;LAB SERVICE;**1038**;NOV 01, 1997;Build 6
;
EEP ; EP - Ersatz EP
D EEP^BLRGMENU
Q
;
; Cloned from the LR*5.2*1030 LRSORA routine
;
; This version is designed to be tasked. It will REJECT interactive reporting.
;
BEGIN ; EP - Beginning
I $D(ZTQUEUED)<1 D Q
. W !!,?4,"This report can only be run from TASKMAN."
. D PRESSKEY^BLRGMENU(9)
S:$D(ZTQUEUED) ZTREQ="@"
;
GETPARAM ; EP - Get the parameters from the IHS LAB SUPERVISOR TASKED REPORTS PARAMETERS (#90475.7) file
NEW GPD0,GPD1,LRCNT,LRPTS,LREND,LRLONG,LRSDT,LREDT,LRTW
;
S (GPD0,GPD1)=1
;
D INIT,GDT,GAA,GLRT
I LREND<1 D
. D SORTBY,SELLOC,GDV
. S IOP="`"_$G(^BLRLSRP(GPD0,2,GPD1,5))
. S %ZIS="Q"
. S ZTSAVE("LR*")=""
. S ZTSAVE("GP*")=""
. D EN^XUTMDEVQ("RUN^BLRSORA","TASKED IHS LAB HIGH/LOW VALUE REPORT",.ZTSAVE,.%ZIS)
S LREND=1
D STOP
Q
;
SORTBY ; EP - Determine SORT BY parameter
NEW SORTBY
;
S SORTBY=$P($G(^BLRLSRP(GPD0,2,GPD1,3)),U)
S LRSRT=$S($L(SORTBY):SORTBY,1:"P")
Q
;
SELLOC ; EP - Get Locations from 90475.7, if they exist
S LRLCS=0
Q:$D(^BLRLSRP(GPD0,2,GPD1,4,0))<1 ; Retrun if no entries
;
NEW LOCIEN,LOCSUB,LOCSUBAB,CNTLOC
;
S (CNTLOC,LOCSUB)=0
F S LOCSUB=$O(^BLRLSRP(GPD0,2,GPD1,4,LOCSUB)) Q:LOCSUB<1 D
. S LOCIEN=$G(^BLRLSRP(GPD0,2,GPD1,4,LOCSUB,0))
. S LOCSUBAB=$$GET1^DIQ(44,LOCIEN,"ABBREVIATION")
. Q:$L(LOCSUBAB)<1
. ;
. S CNTLOC=CNTLOC+1
. S LRLCS=CNTLOC
. S LRLCS(LOCSUBAB)=LOCIEN
I $G(LRLCS) S LRLCS("NO ABRV")=""
Q
;
RUN ;
K ^TMP("LR",$J)
S:$D(ZTQUEUED) ZTREQ="@" U IO
S (LRPAG,LREND)=0,$P(LRDASH,"-",IOM)="-"
K %DT S X=$P(LRSDT,"."),%DT="X" D ^%DT,DD^LRX S LRSDAT=Y
K %DT S X=LREDT,%DT="X" D ^%DT,DD^LRX S LREDAT=Y
S LRHDR2="For date range: "_LREDAT_" to "_LRSDAT
D:'LREND START^LRSORA2
D:$D(ZTQUEUED) STOP
Q
STOP ;
D STOP^LRSORA0
Q
GAA ; EP - Get Accession Areas
S LRAA=0
Q:$D(^BLRLSRP(GPD0,2,GPD1,1,0))<1
;
NEW GAAD2,GLRAA,GLRAAAB
;
S GAAD2=0
F S GAAD2=$O(^BLRLSRP(GPD0,2,GPD1,1,GAAD2)) Q:GAAD2<1 D
. S GLRAA=$G(^BLRLSRP(GPD0,2,GPD1,1,GAAD2,0))
. S GLRAAAB=$$GET1^DIQ(68,GLRAA,"ABBREVIATION")
. Q:$L(GLRAAAB)<1
. ;
. S LRAA(GLRAAAB)=GLRAA
. S LRAA=GLRAA
;
Q
GLRT ; EP - Get LaboRatory Tests
K LRTST
I $D(^BLRLSRP(GPD0,2,GPD1,2,0))<1 D Q ; Skip if no tests defined
. W !!,"No Tests Defined in the IHS LAB SUPERVISOR TASKED REPORTS PARAMETERS dictionary"
. W !,?4,"for the IHS Lab tasked version of 'Search for high/low values of a test'."
. W !!
. S LREND=1
;
NEW CHAR,CNT,F60DNIEN,F60IEN,F60NAME,GPD3,GPD4,I,IEN,OPERATOR,OPNAME,OPVAL,STR,VALUE
;
S (CNT,GPD3)=0
F S GPD3=$O(^BLRLSRP(GPD0,2,GPD1,2,GPD3)) Q:GPD3<1 D
. S IEN=GPD3_","_GPD1_","_GPD0
. S F60IEN=$$GET1^DIQ(90475.723,IEN,"Laboratory Tests","I")
. S F60NAME=$$GET1^DIQ(90475.723,IEN,"Laboratory Tests")
. S F60DNIEN=$$GET1^DIQ(60,F60IEN,400,"I")
. S GPD4=0
. F S GPD4=$O(^BLRLSRP(GPD0,2,GPD1,2,GPD3,1,GPD4)) Q:GPD4<1 D
.. S IEN=GPD4_","_GPD3_","_GPD1_","_GPD0
.. S OPERATOR=$$GET1^DIQ(90475.7231,IEN,"Operator","I")
.. S OPNAME=$$GET1^DIQ(90475.7231,IEN,"Operator")
.. S VALUE=$$GET1^DIQ(90475.7231,IEN,"Value","I")
.. Q:OPERATOR=""!($L(VALUE)<1)!(OPERATOR>3)
.. ;
.. S OPVAL=$S(OPERATOR=0:"<",OPERATOR=1:">",OPERATOR=2:"=",OPERATOR=3:"[")
.. ;
.. S CNT=CNT+1
.. S STR="I $D(^("_F60DNIEN_"))"
.. S STR=STR_" S LRVX=$P(^("_F60DNIEN_"),U),LRVX=$S(LRVX?1A.E:LRVX,""<>""[$E(LRVX):$E(LRVX,2,$L(LRVX)),1:LRVX)"
.. S STR=STR_" I LRVX"_OPVAL_VALUE
.. S LRTST(CNT,1)=STR
.. S LRTST(CNT,2)=F60NAME_"^^"_OPNAME_" "_VALUE
.. S LRTST(CNT,3)=F60DNIEN_"^"
;
Q:CNT<1
;
S LRTST=CNT
S LRTST(0)="A"
F I=2:1:CNT S LRTST(0)=$G(LRTST(0))_"!"_$C(64+I)
Q
;
Q
;
GTSC ;
S LRA=1
F I=0:0 D @$S(LRA=2:"SPEC",LRA=3:"CND",LRA=4:"GV",1:"TST") Q:LRA=0
Q
;
TST ;
K DIC S DIC="^LAB(60,",DIC(0)="AEMOQ"
S DIC("S")="I $P(^(0),U,5)[""CH"",""BO""[$P(^(0),U,3)" D ^DIC
S LRA=$S(Y>0:2,1:0)
S:X["^" LREND=1
I Y>0 S $P(LRTST(LRTST,3),"^",1)=$P($P(^LAB(60,+Y,0),U,5),";",2)
I S $P(LRTST(LRTST,2),"^",1)=$P(Y,"^",2)
Q
;
SPEC ;
S LRCNT=LRCNT+1
K DIC S DIC="^LAB(61,",DIC(0)="AEMOQ"
S DIC("A")="Select SPECIMEN/SITE: ANY// " D ^DIC
S:Y<1 $P(LRTST(LRTST,3),"^",2)="",$P(LRTST(LRTST,2),"^",2)=""
S LRA=$S(X["^":1,1:3)
I Y>0 S $P(LRTST(LRTST,3),"^",2)=+Y,$P(LRTST(LRTST,2),"^",2)=$P(Y,"^",2)
Q
;
CND ;
W !,"Select CONDITION: " R X:DTIME S:'$T X="^"
D @$S(X?1.N1":"1.N:"RNG",1:"GC") Q
RNG ;
N Y
S LRV=+$P(X,":",1),LRV2=+$P(X,":",2),LRA=0
S:LRV>LRV2 X=LRV,LRV=LRV2,LRV2=X
S $P(LRTST(LRTST,2),U,3)="BETWEEN "_LRV_" AND "_LRV2
S X=$P(LRTST(LRTST,3),U,1)
S Y="I $D(^("_X
S Y=Y_")) S LRVX=$P(^("_X
S Y=Y_"),U),LRVX=$S(LRVX?1A.E:LRVX,"
S Y=Y_"""<>""[$E(LRVX):$E(LRVX,2,$L(LRVX)),1:LRVX)"
S LRTST(LRTST,1)=Y_" I LRVX>"_LRV_",LRVX<"_LRV2
D ASPC Q
GC ;
S DIC="^DOPT(""DIS"",",DIC(0)="EMQZ",DIC("S")="I $L($P(^(0),U,2))"
D ^DIC K DIC
S LRA=$S(X["^":2,Y<0:3,1:4) D:X["?" HLP1 W:'$L(X) " ??" Q:Y<0
GV ;
N LY,ALPHA,DEC,II,TT
W !,"Enter VALUE: "
R X:DTIME S:'$T X="^"
S LRA=$S(X["^":3,"?"[X:4,1:0)
W:X="" " ??" D:X["?" HLP2 Q:LRA
S:"<>"[$P(Y(0),U,2) X=+X
S $P(LRTST(LRTST,2),"^",3)=$P(Y(0),"^",1)_" "_X
;
; determine if entered value is alphanumeric
S (ALPHA,DEC)=0
F II=1:1 S TT=$E(X,II) Q:TT="" D Q:ALPHA
. I TT?1N Q
. I TT?1"." S DEC=DEC+1 S:DEC>1 ALPHA=1 Q
. S ALPHA=1
I X="""""" S ALPHA=0 ;ADDED FOR LR*5.2*357
;
S LY="I $D(^("_$P(LRTST(LRTST,3),U)
S LY=LY_")) S LRVX=$P(^("
S LY=LY_$P(LRTST(LRTST,3),U)
S LY=LY_"),U),LRVX=$S(LRVX?1A.E:LRVX,"
S LY=LY_"""<>""[$E(LRVX):$E(LRVX,2,$L(LRVX)),1:LRVX) I LRVX"
S LRTST(LRTST,1)=LY_$P(Y(0),U,2)_$S(ALPHA:""""_X_"""",1:X) D ASPC Q
ASPC ;
S:$L($P(LRTST(LRTST,3),U,2)) LRTST(LRTST,1)=LRTST(LRTST,1)_",$P(^(0),U,5)="_$P(LRTST(LRTST,3),U,2) Q
;
INIT ; EP - Initialization
S LRCNT=0
S LRPTS=0
S U="^"
S LREND=0
S LRLONG=0
S LRSDT="TODAY"
S LREDT="T-1"
S LRTW=.00001
S:'$D(DTIME) DTIME=300
Q
;
GDT ;
NEW DTRANGE,GOBACK
;
S DTRANGE=+$$GET1^DIQ(90475.72,GPD1_","_GPD0,"Date Range","I")
S GOBACK=$S(DTRANGE=1:7,DTRANGE=2:30,DTRANGE=3:365,1:1)
S:DTRANGE=3 LRLONG=1
S LREDT=$$HTFM^XLFDT(+$H-GOBACK)
S LRSDT=$$DT^XLFDT_".5"
S LRHDR2="For date range: "_$$FMTE^XLFDT(LREDT,"5DZ")_" to "_$$FMTE^XLFDT(LRSDT,"5DZ")
Q
;
GSLOG ; EP - Get Search LOGic
; Note that if the Search logic fields are null, cannot run the report. Skip
I +$O(^BLRLSRP(GPD0,2,GPD1,2,0))<1 D Q
. W !!,"Search logic fields in 90745.7 are empty."
. W !!,"Cannot do report."
. S LREND=1
;
S:LRTST=1 LRTST(0)="A" D:LRTST>1 EN^LRSORA1 S:LRTST<1 LREND=1 Q
;
GDV ;
S %ZIS="Q" D ^%ZIS K %ZIS I POP S LREND=1 Q
I $D(IO("Q")) K IO("Q") S (LRQUE,LREND)=1,ZTRTN="RUN^LRSORA",ZTDESC="Lab Special Report",ZTSAVE("LR*")="" D ^%ZTLOAD
Q
HLP1 ;
W !,"A VALUE RANGE may also be entered (value:value).",!," For Example, 100:200 will search for values between 100 and 200.",!
Q
HLP2 ;
W !,"Enter a value for the comparison: "
W $P(LRTST(LRTST,2),U,1)," ",$P(Y(0),U,1)_" _____."
Q
XX ;
WAIT K DIR S DIR(0)="E" D ^DIR S:($D(DUOUT))!($D(DTOUT)) LREND=1
Q
BLRSORA ;VA/DRH/DALISC - HIGH/LOW VALUE TASKED REPORT ;2/19/91 11:42 ;
+1 ;;5.2;LAB SERVICE;**1038**;NOV 01, 1997;Build 6
+2 ;
EEP ; EP - Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
+4 ; Cloned from the LR*5.2*1030 LRSORA routine
+5 ;
+6 ; This version is designed to be tasked. It will REJECT interactive reporting.
+7 ;
BEGIN ; EP - Beginning
+1 IF $DATA(ZTQUEUED)<1
Begin DoDot:1
+2 WRITE !!,?4,"This report can only be run from TASKMAN."
+3 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 ;
GETPARAM ; EP - Get the parameters from the IHS LAB SUPERVISOR TASKED REPORTS PARAMETERS (#90475.7) file
+1 NEW GPD0,GPD1,LRCNT,LRPTS,LREND,LRLONG,LRSDT,LREDT,LRTW
+2 ;
+3 SET (GPD0,GPD1)=1
+4 ;
+5 DO INIT
DO GDT
DO GAA
DO GLRT
+6 IF LREND<1
Begin DoDot:1
+7 DO SORTBY
DO SELLOC
DO GDV
+8 SET IOP="`"_$GET(^BLRLSRP(GPD0,2,GPD1,5))
+9 SET %ZIS="Q"
+10 SET ZTSAVE("LR*")=""
+11 SET ZTSAVE("GP*")=""
+12 DO EN^XUTMDEVQ("RUN^BLRSORA","TASKED IHS LAB HIGH/LOW VALUE REPORT",.ZTSAVE,.%ZIS)
End DoDot:1
+13 SET LREND=1
+14 DO STOP
+15 QUIT
+16 ;
SORTBY ; EP - Determine SORT BY parameter
+1 NEW SORTBY
+2 ;
+3 SET SORTBY=$PIECE($GET(^BLRLSRP(GPD0,2,GPD1,3)),U)
+4 SET LRSRT=$SELECT($LENGTH(SORTBY):SORTBY,1:"P")
+5 QUIT
+6 ;
SELLOC ; EP - Get Locations from 90475.7, if they exist
+1 SET LRLCS=0
+2 ; Retrun if no entries
IF $DATA(^BLRLSRP(GPD0,2,GPD1,4,0))<1
QUIT
+3 ;
+4 NEW LOCIEN,LOCSUB,LOCSUBAB,CNTLOC
+5 ;
+6 SET (CNTLOC,LOCSUB)=0
+7 FOR
SET LOCSUB=$ORDER(^BLRLSRP(GPD0,2,GPD1,4,LOCSUB))
IF LOCSUB<1
QUIT
Begin DoDot:1
+8 SET LOCIEN=$GET(^BLRLSRP(GPD0,2,GPD1,4,LOCSUB,0))
+9 SET LOCSUBAB=$$GET1^DIQ(44,LOCIEN,"ABBREVIATION")
+10 IF $LENGTH(LOCSUBAB)<1
QUIT
+11 ;
+12 SET CNTLOC=CNTLOC+1
+13 SET LRLCS=CNTLOC
+14 SET LRLCS(LOCSUBAB)=LOCIEN
End DoDot:1
+15 IF $GET(LRLCS)
SET LRLCS("NO ABRV")=""
+16 QUIT
+17 ;
RUN ;
+1 KILL ^TMP("LR",$JOB)
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
+3 SET (LRPAG,LREND)=0
SET $PIECE(LRDASH,"-",IOM)="-"
+4 KILL %DT
SET X=$PIECE(LRSDT,".")
SET %DT="X"
DO ^%DT
DO DD^LRX
SET LRSDAT=Y
+5 KILL %DT
SET X=LREDT
SET %DT="X"
DO ^%DT
DO DD^LRX
SET LREDAT=Y
+6 SET LRHDR2="For date range: "_LREDAT_" to "_LRSDAT
+7 IF 'LREND
DO START^LRSORA2
+8 IF $DATA(ZTQUEUED)
DO STOP
+9 QUIT
STOP ;
+1 DO STOP^LRSORA0
+2 QUIT
GAA ; EP - Get Accession Areas
+1 SET LRAA=0
+2 IF $DATA(^BLRLSRP(GPD0,2,GPD1,1,0))<1
QUIT
+3 ;
+4 NEW GAAD2,GLRAA,GLRAAAB
+5 ;
+6 SET GAAD2=0
+7 FOR
SET GAAD2=$ORDER(^BLRLSRP(GPD0,2,GPD1,1,GAAD2))
IF GAAD2<1
QUIT
Begin DoDot:1
+8 SET GLRAA=$GET(^BLRLSRP(GPD0,2,GPD1,1,GAAD2,0))
+9 SET GLRAAAB=$$GET1^DIQ(68,GLRAA,"ABBREVIATION")
+10 IF $LENGTH(GLRAAAB)<1
QUIT
+11 ;
+12 SET LRAA(GLRAAAB)=GLRAA
+13 SET LRAA=GLRAA
End DoDot:1
+14 ;
+15 QUIT
GLRT ; EP - Get LaboRatory Tests
+1 KILL LRTST
+2 ; Skip if no tests defined
IF $DATA(^BLRLSRP(GPD0,2,GPD1,2,0))<1
Begin DoDot:1
+3 WRITE !!,"No Tests Defined in the IHS LAB SUPERVISOR TASKED REPORTS PARAMETERS dictionary"
+4 WRITE !,?4,"for the IHS Lab tasked version of 'Search for high/low values of a test'."
+5 WRITE !!
+6 SET LREND=1
End DoDot:1
QUIT
+7 ;
+8 NEW CHAR,CNT,F60DNIEN,F60IEN,F60NAME,GPD3,GPD4,I,IEN,OPERATOR,OPNAME,OPVAL,STR,VALUE
+9 ;
+10 SET (CNT,GPD3)=0
+11 FOR
SET GPD3=$ORDER(^BLRLSRP(GPD0,2,GPD1,2,GPD3))
IF GPD3<1
QUIT
Begin DoDot:1
+12 SET IEN=GPD3_","_GPD1_","_GPD0
+13 SET F60IEN=$$GET1^DIQ(90475.723,IEN,"Laboratory Tests","I")
+14 SET F60NAME=$$GET1^DIQ(90475.723,IEN,"Laboratory Tests")
+15 SET F60DNIEN=$$GET1^DIQ(60,F60IEN,400,"I")
+16 SET GPD4=0
+17 FOR
SET GPD4=$ORDER(^BLRLSRP(GPD0,2,GPD1,2,GPD3,1,GPD4))
IF GPD4<1
QUIT
Begin DoDot:2
+18 SET IEN=GPD4_","_GPD3_","_GPD1_","_GPD0
+19 SET OPERATOR=$$GET1^DIQ(90475.7231,IEN,"Operator","I")
+20 SET OPNAME=$$GET1^DIQ(90475.7231,IEN,"Operator")
+21 SET VALUE=$$GET1^DIQ(90475.7231,IEN,"Value","I")
+22 IF OPERATOR=""!($LENGTH(VALUE)<1)!(OPERATOR>3)
QUIT
+23 ;
+24 SET OPVAL=$SELECT(OPERATOR=0:"<",OPERATOR=1:">",OPERATOR=2:"=",OPERATOR=3:"[")
+25 ;
+26 SET CNT=CNT+1
+27 SET STR="I $D(^("_F60DNIEN_"))"
+28 SET STR=STR_" S LRVX=$P(^("_F60DNIEN_"),U),LRVX=$S(LRVX?1A.E:LRVX,""<>""[$E(LRVX):$E(LRVX,2,$L(LRVX)),1:LRVX)"
+29 SET STR=STR_" I LRVX"_OPVAL_VALUE
+30 SET LRTST(CNT,1)=STR
+31 SET LRTST(CNT,2)=F60NAME_"^^"_OPNAME_" "_VALUE
+32 SET LRTST(CNT,3)=F60DNIEN_"^"
End DoDot:2
End DoDot:1
+33 ;
+34 IF CNT<1
QUIT
+35 ;
+36 SET LRTST=CNT
+37 SET LRTST(0)="A"
+38 FOR I=2:1:CNT
SET LRTST(0)=$GET(LRTST(0))_"!"_$CHAR(64+I)
+39 QUIT
+40 ;
+41 QUIT
+42 ;
GTSC ;
+1 SET LRA=1
+2 FOR I=0:0
DO @$SELECT(LRA=2:"SPEC",LRA=3:"CND",LRA=4:"GV",1:"TST")
IF LRA=0
QUIT
+3 QUIT
+4 ;
TST ;
+1 KILL DIC
SET DIC="^LAB(60,"
SET DIC(0)="AEMOQ"
+2 SET DIC("S")="I $P(^(0),U,5)[""CH"",""BO""[$P(^(0),U,3)"
DO ^DIC
+3 SET LRA=$SELECT(Y>0:2,1:0)
+4 IF X["^"
SET LREND=1
+5 IF Y>0
SET $PIECE(LRTST(LRTST,3),"^",1)=$PIECE($PIECE(^LAB(60,+Y,0),U,5),";",2)
+6 IF $TEST
SET $PIECE(LRTST(LRTST,2),"^",1)=$PIECE(Y,"^",2)
+7 QUIT
+8 ;
SPEC ;
+1 SET LRCNT=LRCNT+1
+2 KILL DIC
SET DIC="^LAB(61,"
SET DIC(0)="AEMOQ"
+3 SET DIC("A")="Select SPECIMEN/SITE: ANY// "
DO ^DIC
+4 IF Y<1
SET $PIECE(LRTST(LRTST,3),"^",2)=""
SET $PIECE(LRTST(LRTST,2),"^",2)=""
+5 SET LRA=$SELECT(X["^":1,1:3)
+6 IF Y>0
SET $PIECE(LRTST(LRTST,3),"^",2)=+Y
SET $PIECE(LRTST(LRTST,2),"^",2)=$PIECE(Y,"^",2)
+7 QUIT
+8 ;
CND ;
+1 WRITE !,"Select CONDITION: "
READ X:DTIME
IF '$TEST
SET X="^"
+2 DO @$SELECT(X?1.N1":"1.N:"RNG",1:"GC")
QUIT
RNG ;
+1 NEW Y
+2 SET LRV=+$PIECE(X,":",1)
SET LRV2=+$PIECE(X,":",2)
SET LRA=0
+3 IF LRV>LRV2
SET X=LRV
SET LRV=LRV2
SET LRV2=X
+4 SET $PIECE(LRTST(LRTST,2),U,3)="BETWEEN "_LRV_" AND "_LRV2
+5 SET X=$PIECE(LRTST(LRTST,3),U,1)
+6 SET Y="I $D(^("_X
+7 SET Y=Y_")) S LRVX=$P(^("_X
+8 SET Y=Y_"),U),LRVX=$S(LRVX?1A.E:LRVX,"
+9 SET Y=Y_"""<>""[$E(LRVX):$E(LRVX,2,$L(LRVX)),1:LRVX)"
+10 SET LRTST(LRTST,1)=Y_" I LRVX>"_LRV_",LRVX<"_LRV2
+11 DO ASPC
QUIT
GC ;
+1 SET DIC="^DOPT(""DIS"","
SET DIC(0)="EMQZ"
SET DIC("S")="I $L($P(^(0),U,2))"
+2 DO ^DIC
KILL DIC
+3 SET LRA=$SELECT(X["^":2,Y<0:3,1:4)
IF X["?"
DO HLP1
IF '$LENGTH(X)
WRITE " ??"
IF Y<0
QUIT
GV ;
+1 NEW LY,ALPHA,DEC,II,TT
+2 WRITE !,"Enter VALUE: "
+3 READ X:DTIME
IF '$TEST
SET X="^"
+4 SET LRA=$SELECT(X["^":3,"?"[X:4,1:0)
+5 IF X=""
WRITE " ??"
IF X["?"
DO HLP2
IF LRA
QUIT
+6 IF "<>"[$PIECE(Y(0),U,2)
SET X=+X
+7 SET $PIECE(LRTST(LRTST,2),"^",3)=$PIECE(Y(0),"^",1)_" "_X
+8 ;
+9 ; determine if entered value is alphanumeric
+10 SET (ALPHA,DEC)=0
+11 FOR II=1:1
SET TT=$EXTRACT(X,II)
IF TT=""
QUIT
Begin DoDot:1
+12 IF TT?1N
QUIT
+13 IF TT?1"."
SET DEC=DEC+1
IF DEC>1
SET ALPHA=1
QUIT
+14 SET ALPHA=1
End DoDot:1
IF ALPHA
QUIT
+15 ;ADDED FOR LR*5.2*357
IF X=""""""
SET ALPHA=0
+16 ;
+17 SET LY="I $D(^("_$PIECE(LRTST(LRTST,3),U)
+18 SET LY=LY_")) S LRVX=$P(^("
+19 SET LY=LY_$PIECE(LRTST(LRTST,3),U)
+20 SET LY=LY_"),U),LRVX=$S(LRVX?1A.E:LRVX,"
+21 SET LY=LY_"""<>""[$E(LRVX):$E(LRVX,2,$L(LRVX)),1:LRVX) I LRVX"
+22 SET LRTST(LRTST,1)=LY_$PIECE(Y(0),U,2)_$SELECT(ALPHA:""""_X_"""",1:X)
DO ASPC
QUIT
ASPC ;
+1 IF $LENGTH($PIECE(LRTST(LRTST,3),U,2))
SET LRTST(LRTST,1)=LRTST(LRTST,1)_",$P(^(0),U,5)="_$PIECE(LRTST(LRTST,3),U,2)
QUIT
+2 ;
INIT ; EP - Initialization
+1 SET LRCNT=0
+2 SET LRPTS=0
+3 SET U="^"
+4 SET LREND=0
+5 SET LRLONG=0
+6 SET LRSDT="TODAY"
+7 SET LREDT="T-1"
+8 SET LRTW=.00001
+9 IF '$DATA(DTIME)
SET DTIME=300
+10 QUIT
+11 ;
GDT ;
+1 NEW DTRANGE,GOBACK
+2 ;
+3 SET DTRANGE=+$$GET1^DIQ(90475.72,GPD1_","_GPD0,"Date Range","I")
+4 SET GOBACK=$SELECT(DTRANGE=1:7,DTRANGE=2:30,DTRANGE=3:365,1:1)
+5 IF DTRANGE=3
SET LRLONG=1
+6 SET LREDT=$$HTFM^XLFDT(+$HOROLOG-GOBACK)
+7 SET LRSDT=$$DT^XLFDT_".5"
+8 SET LRHDR2="For date range: "_$$FMTE^XLFDT(LREDT,"5DZ")_" to "_$$FMTE^XLFDT(LRSDT,"5DZ")
+9 QUIT
+10 ;
GSLOG ; EP - Get Search LOGic
+1 ; Note that if the Search logic fields are null, cannot run the report. Skip
+2 IF +$ORDER(^BLRLSRP(GPD0,2,GPD1,2,0))<1
Begin DoDot:1
+3 WRITE !!,"Search logic fields in 90745.7 are empty."
+4 WRITE !!,"Cannot do report."
+5 SET LREND=1
End DoDot:1
QUIT
+6 ;
+7 IF LRTST=1
SET LRTST(0)="A"
IF LRTST>1
DO EN^LRSORA1
IF LRTST<1
SET LREND=1
QUIT
+8 ;
GDV ;
+1 SET %ZIS="Q"
DO ^%ZIS
KILL %ZIS
IF POP
SET LREND=1
QUIT
+2 IF $DATA(IO("Q"))
KILL IO("Q")
SET (LRQUE,LREND)=1
SET ZTRTN="RUN^LRSORA"
SET ZTDESC="Lab Special Report"
SET ZTSAVE("LR*")=""
DO ^%ZTLOAD
+3 QUIT
HLP1 ;
+1 WRITE !,"A VALUE RANGE may also be entered (value:value).",!," For Example, 100:200 will search for values between 100 and 200.",!
+2 QUIT
HLP2 ;
+1 WRITE !,"Enter a value for the comparison: "
+2 WRITE $PIECE(LRTST(LRTST,2),U,1)," ",$PIECE(Y(0),U,1)_" _____."
+3 QUIT
XX ;
WAIT KILL DIR
SET DIR(0)="E"
DO ^DIR
IF ($DATA(DUOUT))!($DATA(DTOUT))
SET LREND=1
+1 QUIT
