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

BLRLTRRR.m

Go to the documentation of this file. 
  1. BLRLTRRR ; IHS/MSC/MKK - IHS Lab Laboratory Test (#60) file's Reference Ranges Reports; 22-Oct-2013 09:22 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
  1.  ;
  1. EEP ; Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1. EP ; 
  1. PEP ; EP
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  ;
  1.  D ADDTMENU^BLRGMENU("MAKERPT^BLRLTRRR","'SEX' Ref Range(s) Report")
  1.  ; D ADDTMENU^BLRGMENU("EMAIL^BLRLTRRR","'SEX' Ref Range(s) Rpt (MailMan)")
  1.  ;
  1.  ; Main Menu driver
  1.  D MENUDRVR^BLRGMENU("RPMS Laboratory Test (#60) File","Reference Ranges Reports")
  1.  Q
  1.  ;
  1. EMAIL ; EP - E-Mail Version 
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D GETDATA
  1.  ;
  1.  Q:$D(^TMP("BLRLTRRR"))<1
  1.  ;
  1.  S TAB=$J("",5),LINE=0
  1.  S TAB2=$J("",7)
  1.  S TAB3=$J("",10)
  1.  D MAILHEAD(.ARRAY,.LINE)
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(^TMP("BLRLTRRR",$J,IEN))  Q:IEN<1  D
  1.  . D MAKELINE(.ARRAY,.LINE," ")
  1.  . S TESTNAME=$$GET1^DIQ(60,IEN,"NAME")
  1.  . D MAKELINE(.ARRAY,.LINE,TAB_"TEST:"_TESTNAME_" ["_IEN_"]")
  1.  . S SSIEN=0
  1.  . F  S SSIEN=$O(^TMP("BLRLTRRR",$J,IEN,SSIEN))  Q:SSIEN<1  D
  1.  .. D BUILDMSG(.ARRAY,.LINE,IEN,SSIEN)
  1.  ;
  1.  ; Send E-Mail
  1.  D SENDMAIL^BLRUTIL3("FILE 60 'SEX' REF RANGE CHECK",.ARRAY,"BLRLTRRR",1)
  1.  ;
  1.  K ^TMP("BLRLTRRR")
  1.  Q
  1.  ;
  1. GETDATA ; EP - Gather Data
  1.  K ^TMP("BLRLTRRR")
  1.  S IEN=.9999999
  1.  F  S IEN=$O(^LAB(60,IEN))  Q:IEN<1  D
  1.  . S SSIEN=0
  1.  . F  S SSIEN=$O(^LAB(60,IEN,1,SSIEN))  Q:SSIEN<1  D
  1.  .. S STR=$G(^LAB(60,IEN,1,SSIEN,0))
  1.  .. S:$P(STR,"^",2,5)["SEX" ^TMP("BLRLTRRR",$J,IEN,SSIEN)=STR
  1.  Q
  1.  ;
  1. MAILHEAD(ARRAY,LINE) ; EP - Build "Header" for E-Mail
  1.  D MAKELINE(.ARRAY,.LINE,$TR($$CJ^XLFSTR("@LABORATORY@TEST@FILE@ENTRIES@",60)," @","= "))
  1.  D MAKELINE(.ARRAY,.LINE," ")
  1.  D MAKELINE(.ARRAY,.LINE,TAB_"Entries with SEX in Reference and/or Critical Ranges")
  1.  Q
  1.  ;
  1. MAKELINE(ARRAY,LINE,LINESTR) ; EP
  1.  S LINE=LINE+1
  1.  S ARRAY(LINE)=LINESTR
  1.  Q
  1.  ;
  1. BUILDMSG(ARRAY,LINE,IEN,SSIEN) ; EP - Build the Message
  1.  D SITESPEC(IEN,SSIEN)
  1.  ;
  1.  D MAKELINE(.ARRAY,.LINE,TAB2_"SITE/SPEC:"_F61DESC_" ["_SSIEN_"]")
  1.  ;
  1.  D:REFLOW["SEX" MAKELINE(.ARRAY,.LINE,TAB3_"Ref Low:"_REFLOW)
  1.  D:REFHIGH["SEX" MAKELINE(.ARRAY,.LINE,TAB3_"Ref High:"_REFHIGH)
  1.  D:CRITLOW["SEX" MAKELINE(.ARRAY,.LINE,TAB3_"Crit Low:"_CRITLOW)
  1.  D:CRITHIGH["SEX" MAKELINE(.ARRAY,.LINE,TAB3_"Crit High:"_CRITHIGH)
  1.  Q
  1.  ;
  1. SITESPEC(IEN,SSIEN) ; EP - Break out SITE/SPECIMEN Values
  1.  S STR=$G(^LAB(60,IEN,1,SSIEN,0))
  1.  S F61PTR=$P(STR,"^")
  1.  S F61DESC=$$GET1^DIQ(61,F61PTR,"NAME")
  1.  S REFLOW=$P(STR,"^",2)
  1.  S REFHIGH=$P(STR,"^",3)
  1.  S CRITLOW=$P(STR,"^",4)
  1.  S CRITHIGH=$P(STR,"^",5)
  1.  S THERLOW=$P(STR,"^",11)
  1.  S THERHIGH=$P(STR,"^",12)
  1.  Q
  1.  ;
  1. MAKERPT ; EP - Report
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D GETDATA
  1.  ;
  1.  I $D(^TMP("BLRLTRRR"))<1 D  Q
  1.  . W !,?4,"No entries in Laboratory Test (#60) File found to have 'SEX' in Ref Ranges."
  1.  . D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  D MAKERPTI
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(^TMP("BLRLTRRR",$J,IEN))  Q:IEN<1  D
  1.  . S TESTNAME=$$GET1^DIQ(60,IEN,"NAME")
  1.  . S SSIEN=0
  1.  . F  S SSIEN=$O(^TMP("BLRLTRRR",$J,IEN,SSIEN))  Q:SSIEN<1!(QFLG="Q")  D MAKERPTL
  1.  ;
  1.  D ^%ZISC
  1.  D PRESSKEY^BLRGMENU(4)
  1.  Q
  1.  ;
  1. MAKERPTI ; EP - Initialization
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  ;
  1.  S HEADER(1)="FILE 60 'SEX' REF RANGE CHECK"
  1.  S HEADER(2)=" "
  1.  D HEADERDT^BLRGMENU
  1.  D HEADONE^BLRGMENU(.HDRONE)
  1.  ;
  1.  S HEADER(2)="'SEX' in Reference and/or Critical Ranges"
  1.  S HEADER(3)=" "
  1.  S HEADER(4)=$TR($$CJ^XLFSTR("@File@60@",27)," @","= ")
  1.  S $E(HEADER(4),30)="SITE/"
  1.  S HEADER(5)="IEN"
  1.  S $E(HEADER(5),10)="Description"
  1.  S $E(HEADER(5),30)="SPEC"
  1.  S $E(HEADER(5),40)="Ranges"
  1.  ;
  1.  D ^%ZIS
  1.  U IO
  1.  ;
  1.  S MAXLINES=IOSL-4
  1.  S LINES=MAXLINES+10,PG=0,QFLG="NO"
  1.  Q
  1.  ;
  1. MAKERPTL ; EP - Line of Data
  1.  I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,.HDRONE)  Q:QFLG="Q"
  1.  ;
  1.  D SITESPEC(IEN,SSIEN)
  1.  ;
  1.  W IEN
  1.  W ?9,$E(TESTNAME,1,18)
  1.  W ?29,SSIEN
  1.  I REFLOW["SEX" W ?39,"Ref Low:",?49,$E(REFLOW,1,31),!  S LINES=LINES+1
  1.  I REFHIGH["SEX" W ?39,"Ref High:",?49,$E(REFHIGH,1,31),!  S LINES=LINES+1
  1.  I CRITLOW["SEX" W ?39,"Crit Low:",?49,$E(CRITLOW,1,31),!  S LINES=LINES+1
  1.  I CRITHIGH["SEX" W ?39,"Crit High:",?49,$E(CRITHIGH,1,31),!  S LINES=LINES+1
  1.  I THERLOW["SEX"  W ?39,"Ther Low:",?49,$E(CRITHIGH,1,31),!  S LINES=LINES+1
  1.  I THERHIGH["SEX" W ?39,"Ther High:",?49,$E(CRITHIGH,1,31),!  S LINES=LINES+1
  1.  Q