Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLRSORA

BLRSORA.m

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