- BLRSORC ; IHS/DIR/FJE - CRITICAL VALUE TASKED REPORT 8/30/87 17:25 ;
- ;;5.2;LR;**1038**;NOV 01, 1997;Build 6
- ;
- EEP ; EP - Ersatz EP
- D EEP^BLRGMENU
- Q
- ;
- ; Cloned from the VA Patch LR*5.2*84 LRSORC routine.
- ;
- BEGIN ; EP - Beginning
- I $D(ZTQUEUED)<1 D Q
- . W !!,?4,"This report can only be run from TASKMAN."
- . D PRESSKEY^BLRGMENU(9)
- ;
- GETPARAM ; EP - Get the parameters from the IHS LAB SUPERVISOR TASKED REPORTS PARAMETERS (#90475.7) file
- S (GPD0,GPD1)=1
- D OPTIONS
- D DEVICE
- I LREND D END^LRSORC1A Q
- Q
- ;
- OPTIONS ;
- D GDR,GAA,SORTBY,SELPAT,SELLOC
- Q
- ;
- GDR ; EP - Get Date Range from 90475.7
- NEW DTRANGE,GOBACK
- ;
- S DTRANGE=+$$GET1^DIQ(90475.73,GPD1_","_GPD0,"Date Range","I")
- S GOBACK=$S(DTRANGE=1:7,DTRANGE=2:30,DTRANGE=3:365,1:1)
- S LREDT=$$HTFM^XLFDT(+$H-GOBACK)
- S LRSDT=$$DT^XLFDT_".5"
- Q
- ;
- GAA ; EP - Get Accession Areas from 90475.7, if they exist
- NEW GAAD2,GLRAA,GLRAAAB
- ;
- S LRAA=0
- Q:$D(^BLRLSRP(GPD0,3,GPD1,1,0))<1
- ;
- S GAAD2=0
- F S GAAD2=$O(^BLRLSRP(GPD0,3,GPD1,1,GAAD2)) Q:GAAD2<1 D
- . S GLRAA=$G(^BLRLSRP(GPD0,3,GPD1,1,GAAD2,0))
- . S GLRAAAB=$$GET1^DIQ(68,GLRAA,"ABBREVIATION")
- . Q:$L(GLRAAAB)<1
- . ;
- . S LRAA(GLRAAAB)=GLRAA
- . S LRAA=GLRAA
- ;
- Q
- ;
- SORTBY ; EP - Determine SORT BY parameter
- NEW SORTBY
- ;
- S SORTBY=$P($G(^BLRLSRP(GPD0,3,GPD1,3)),U)
- S LRSRT=$S($L(SORTBY):SORTBY,1:"P")
- Q
- ;
- SELPAT ; EP - ALL Patients by default
- S LRPTS=0
- Q
- ;
- SELLOC ; EP - Get Locations from 90475.7, if they exist
- S LRLCS=0
- Q:$D(^BLRLSRP(GPD0,3,GPD1,2,0))<1 ; Retrun if no entries
- ;
- NEW LOCIEN,LOCSUB,LOCSUBAB,CNTLOC
- ;
- S (CNTLOC,LOCSUB)=0
- F S LOCSUB=$O(^BLRLSRP(GPD0,3,GPD1,2,LOCSUB)) Q:LOCSUB<1 D
- . S LOCIEN=(^BLRLSRP(GPD0,3,GPD1,2,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
- ;
- DEVICE ;
- S IOP="`"_$P($G(^BLRLSRP(GPD0,3,GPD1,3)),U,2)
- S %ZIS="Q"
- S ZTSAVE("LR*")=""
- D EN^XUTMDEVQ("DQ^BLRSORC","TASKED IHS LAB CRITICAL VALUE REPORT",.ZTSAVE,.%ZIS)
- S LREND=1
- Q
- ;
- DQ ;
- K ^TMP("LR",$J)
- S:$D(ZTQUEUED) ZTREQ="@" U IO
- S (LRPAG,LREND)=0,$P(LRDASH,"-",IOM)="-"
- K %DT S X="N",%DT="T" D ^%DT,DD^LRX S LRDATE=Y
- 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 BUILD^LRSORC1
- D ^LRSORC1A
- QUIT
- BLRSORC ; IHS/DIR/FJE - CRITICAL VALUE TASKED REPORT 8/30/87 17:25 ;
- +1 ;;5.2;LR;**1038**;NOV 01, 1997;Build 6
- +2 ;
- EEP ; EP - Ersatz EP
- +1 DO EEP^BLRGMENU
- +2 QUIT
- +3 ;
- +4 ; Cloned from the VA Patch LR*5.2*84 LRSORC routine.
- +5 ;
- 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 ;
- GETPARAM ; EP - Get the parameters from the IHS LAB SUPERVISOR TASKED REPORTS PARAMETERS (#90475.7) file
- +1 SET (GPD0,GPD1)=1
- +2 DO OPTIONS
- +3 DO DEVICE
- +4 IF LREND
- DO END^LRSORC1A
- QUIT
- +5 QUIT
- +6 ;
- OPTIONS ;
- +1 DO GDR
- DO GAA
- DO SORTBY
- DO SELPAT
- DO SELLOC
- +2 QUIT
- +3 ;
- GDR ; EP - Get Date Range from 90475.7
- +1 NEW DTRANGE,GOBACK
- +2 ;
- +3 SET DTRANGE=+$$GET1^DIQ(90475.73,GPD1_","_GPD0,"Date Range","I")
- +4 SET GOBACK=$SELECT(DTRANGE=1:7,DTRANGE=2:30,DTRANGE=3:365,1:1)
- +5 SET LREDT=$$HTFM^XLFDT(+$HOROLOG-GOBACK)
- +6 SET LRSDT=$$DT^XLFDT_".5"
- +7 QUIT
- +8 ;
- GAA ; EP - Get Accession Areas from 90475.7, if they exist
- +1 NEW GAAD2,GLRAA,GLRAAAB
- +2 ;
- +3 SET LRAA=0
- +4 IF $DATA(^BLRLSRP(GPD0,3,GPD1,1,0))<1
- QUIT
- +5 ;
- +6 SET GAAD2=0
- +7 FOR
- SET GAAD2=$ORDER(^BLRLSRP(GPD0,3,GPD1,1,GAAD2))
- IF GAAD2<1
- QUIT
- Begin DoDot:1
- +8 SET GLRAA=$GET(^BLRLSRP(GPD0,3,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
- +16 ;
- SORTBY ; EP - Determine SORT BY parameter
- +1 NEW SORTBY
- +2 ;
- +3 SET SORTBY=$PIECE($GET(^BLRLSRP(GPD0,3,GPD1,3)),U)
- +4 SET LRSRT=$SELECT($LENGTH(SORTBY):SORTBY,1:"P")
- +5 QUIT
- +6 ;
- SELPAT ; EP - ALL Patients by default
- +1 SET LRPTS=0
- +2 QUIT
- +3 ;
- SELLOC ; EP - Get Locations from 90475.7, if they exist
- +1 SET LRLCS=0
- +2 ; Retrun if no entries
- IF $DATA(^BLRLSRP(GPD0,3,GPD1,2,0))<1
- QUIT
- +3 ;
- +4 NEW LOCIEN,LOCSUB,LOCSUBAB,CNTLOC
- +5 ;
- +6 SET (CNTLOC,LOCSUB)=0
- +7 FOR
- SET LOCSUB=$ORDER(^BLRLSRP(GPD0,3,GPD1,2,LOCSUB))
- IF LOCSUB<1
- QUIT
- Begin DoDot:1
- +8 SET LOCIEN=(^BLRLSRP(GPD0,3,GPD1,2,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 ;
- DEVICE ;
- +1 SET IOP="`"_$PIECE($GET(^BLRLSRP(GPD0,3,GPD1,3)),U,2)
- +2 SET %ZIS="Q"
- +3 SET ZTSAVE("LR*")=""
- +4 DO EN^XUTMDEVQ("DQ^BLRSORC","TASKED IHS LAB CRITICAL VALUE REPORT",.ZTSAVE,.%ZIS)
- +5 SET LREND=1
- +6 QUIT
- +7 ;
- DQ ;
- +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="N"
- SET %DT="T"
- DO ^%DT
- DO DD^LRX
- SET LRDATE=Y
- +5 KILL %DT
- SET X=$PIECE(LRSDT,".")
- SET %DT="X"
- DO ^%DT
- DO DD^LRX
- SET LRSDAT=Y
- +6 KILL %DT
- SET X=LREDT
- SET %DT="X"
- DO ^%DT
- DO DD^LRX
- SET LREDAT=Y
- +7 SET LRHDR2="For date range: "_LREDAT_" to "_LRSDAT
- +8 DO BUILD^LRSORC1
- +9 DO ^LRSORC1A
- +10 QUIT
