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