LRSORA ;DRH/DALISC - HIGH/LOW VALUE REPORT ;2/19/91 11:42 ;
;;5.2;LAB SERVICE;**344,357,369,449**;Sep 27, 1994;Build 4
MAIN D INIT,GDT,GAA:'LREND,GLRT:'LREND,GLOG:'LREND,SORTBY^LRSORA1:'LREND
D PATS^LRSORA1:'LREND,LOCS^LRSORA1:'LREND,GDV:'LREND,RUN:'LREND
D STOP
Q
RUN ;
K ^TMP("LR",$J)
S:$D(ZTQUEUED) ZTREQ="@" U IO
S (LRPAG,LREND)=0,$P(LRDASH,"-",IOM)="-"
S X=LRSDT,LRSDAT=$$FMTE^XLFDT(X,"")
S X=LREDT,LREDAT=$$FMTE^XLFDT(X,"")
S LRHDR2="For date range: "_LREDAT_" to "_LRSDAT
D:'LREND START^LRSORA2
D:$D(ZTQUEUED) STOP
Q
STOP ;
D STOP^LRSORA0
Q
GAA ;
D GAA^LRSORA0
Q
GLRT ;
W ! K LRTST S LRTST=1
F I=0:0 D GTSC Q:'$D(LRTST(LRTST,1)) W ! S LRTST=LRTST+1
K LRTST(LRTST) S LRTST=LRTST-1 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 ;
S LRCNT=0
S U="^"
S LREND=0
S LRLONG=0
S LRSDT="TODAY"
S LREDT="T-1"
S LRTW=.00001
S:'$D(DTIME) DTIME=300
W !,"SPECIAL REPORT - Search for high/low values" Q
GDT ;
D SDF,GSD Q:LREND S LRSDT=Y D GED I Y>0 S LREDT=Y S:LREDT>LRSDT X=LREDT,LREDT=LRSDT,LRSDT=X D CXR
S X=LRSDT,LRSDAT=$$FMTE^XLFDT(X,"")
S X=LREDT,LREDAT=$$FMTE^XLFDT(X,"")
S LRHDR2="For date range: "_LREDAT_" to "_LRSDAT
K LRSDAT,LREDAT,%DT Q
GSD ;
S %DT("A")="Enter START date: ",%DT("B")=LRSDT,%DT="AET"
D ^%DT S LREND=Y<1 Q
GED ;
S %DT("A")="Enter END date: ",%DT("B")=LREDT D ^%DT Q
CXR ;
S LRLONG=1
W !!,"This search may take a few minutes to accumulate precise data.",!
D CXR1
Q
CXR1 ;
F I=0:0 S %=2 W " OK to continue" D YN^DICN S:%=2!(%<0) LREND=1 Q:% W !,"Enter 'YES' to begin the search, 'NO' to exit.",!
Q
SDF ;
I LRSDT?1.7N S Y=LRSDT D DD^LRX S LRSDT=Y
I LREDT?1.7N S Y=LREDT D DD^LRX S LREDT=Y
Q
GLOG ;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSORA 4355 printed Oct 16, 2024@18:21:09 Page 2
LRSORA ;DRH/DALISC - HIGH/LOW VALUE REPORT ;2/19/91 11:42 ;
+1 ;;5.2;LAB SERVICE;**344,357,369,449**;Sep 27, 1994;Build 4
MAIN DO INIT
DO GDT
if 'LREND
DO GAA
if 'LREND
DO GLRT
if 'LREND
DO GLOG
if 'LREND
DO SORTBY^LRSORA1
+1 if 'LREND
DO PATS^LRSORA1
if 'LREND
DO LOCS^LRSORA1
if 'LREND
DO GDV
if 'LREND
DO RUN
+2 DO STOP
+3 QUIT
RUN ;
+1 KILL ^TMP("LR",$JOB)
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
+3 SET (LRPAG,LREND)=0
SET $PIECE(LRDASH,"-",IOM)="-"
+4 SET X=LRSDT
SET LRSDAT=$$FMTE^XLFDT(X,"")
+5 SET X=LREDT
SET LREDAT=$$FMTE^XLFDT(X,"")
+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 ;
+1 DO GAA^LRSORA0
+2 QUIT
GLRT ;
+1 WRITE !
KILL LRTST
SET LRTST=1
+2 FOR I=0:0
DO GTSC
if '$DATA(LRTST(LRTST,1))
QUIT
WRITE !
SET LRTST=LRTST+1
+3 KILL LRTST(LRTST)
SET LRTST=LRTST-1
QUIT
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
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
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
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
INIT ;
+1 SET LRCNT=0
+2 SET U="^"
+3 SET LREND=0
+4 SET LRLONG=0
+5 SET LRSDT="TODAY"
+6 SET LREDT="T-1"
+7 SET LRTW=.00001
+8 if '$DATA(DTIME)
SET DTIME=300
+9 WRITE !,"SPECIAL REPORT - Search for high/low values"
QUIT
GDT ;
+1 DO SDF
DO GSD
if LREND
QUIT
SET LRSDT=Y
DO GED
IF Y>0
SET LREDT=Y
if LREDT>LRSDT
SET X=LREDT
SET LREDT=LRSDT
SET LRSDT=X
DO CXR
+2 SET X=LRSDT
SET LRSDAT=$$FMTE^XLFDT(X,"")
+3 SET X=LREDT
SET LREDAT=$$FMTE^XLFDT(X,"")
+4 SET LRHDR2="For date range: "_LREDAT_" to "_LRSDAT
+5 KILL LRSDAT,LREDAT,%DT
QUIT
GSD ;
+1 SET %DT("A")="Enter START date: "
SET %DT("B")=LRSDT
SET %DT="AET"
+2 DO ^%DT
SET LREND=Y<1
QUIT
GED ;
+1 SET %DT("A")="Enter END date: "
SET %DT("B")=LREDT
DO ^%DT
QUIT
CXR ;
+1 SET LRLONG=1
+2 WRITE !!,"This search may take a few minutes to accumulate precise data.",!
+3 DO CXR1
+4 QUIT
CXR1 ;
+1 FOR I=0:0
SET %=2
WRITE " OK to continue"
DO YN^DICN
if %=2!(%<0)
SET LREND=1
if %
QUIT
WRITE !,"Enter 'YES' to begin the search, 'NO' to exit.",!
+2 QUIT
SDF ;
+1 IF LRSDT?1.7N
SET Y=LRSDT
DO DD^LRX
SET LRSDT=Y
+2 IF LREDT?1.7N
SET Y=LREDT
DO DD^LRX
SET LREDT=Y
+3 QUIT
GLOG ;
+1 if LRTST=1
SET LRTST(0)="A"
if LRTST>1
DO EN^LRSORA1
if LRTST<1
SET LREND=1
QUIT
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
