LR7OSUM1 ;DALOI/staff - Silent Patient cum cont. ;06/03/13 11:17
;;5.2;LAB SERVICE;**121,187,256,286,384,350,427**;Sep 27, 1994;Build 33
;
LRIDT ; from LR7OSUM
N GIOM,LRDRL
S GIOM=$G(LRGIOM)
I GIOM="" D
. S GIOM=$$GET^XPAR("USR^DIV^PKG","LR CH GUI REPORT RIGHT MARGIN",1,"Q")
. I GIOM="" S GIOM=80
K ^TMP("LRPLS",$J),^TMP("LRPLS-ADDR",$J),^TMP("LRCMTINDX",$J)
;
; Flag to determine if reporting laboratory is printed on report
S LRDRL=$$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
;
F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1!(LRIDT>LROUT)!(CT1>COUNT) I $D(^(LRIDT,0)) S X=^(0),CT1=CT1+1 D LRIIDT
D CMTINDX^LR7OSUM2
Q
;
;
LRIIDT ;
N LRIIDT,LRAN,LRPROV,LREAL,LRSPM,LRSPM1,LRSUB,LRTLOC,LRTNN,LRTST,LRTSTS,LRVDT,LRVIDT
S (LRIIDT,LRVIDT)=$P(X,U,1),LREAL=$P(X,U,2),LRSUB=1,LRTNN=1,LRSPM=$P(X,U,5),LRTLOC=$E($P(X,U,11),1,7),LRVDT=$P(X,U,3),LRAN=$P(X,U,6),LRPROV=$P(X,U,10)
;
I LRVDT D Q
. D LRSUB,ORDBY^LR7OSUM2,RELDT^LR7OSUM2
. I LRDRL D RL^LR7OSUM2
. D PLS^LR7OSUM2
;
I LRVDT="" D
. D CHKNP,ORDBY^LR7OSUM2
. I LRDRL D RL^LR7OSUM2
. N OUTCNT
. S OUTCNT=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),OUTCNT=OUTCNT+1
. S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" "
;
Q
;
;
LRSUB ;
N LRTRES
S LRSUB=1
F S LRSUB=$O(^LR(LRDFN,"CH",LRIDT,LRSUB)) Q:LRSUB<1 D
. S X=^LR(LRDFN,"CH",LRIDT,LRSUB)
. S LRTRES=$$TSTRES^LRRPU(LRDFN,"CH",LRIDT,LRSUB,"")
. I $P(LRTRES,"^",1)="" Q
. D SUB1
Q
;
;
SUB1 ;
N LRNOFL,LRTSTVAL
S LRTSTVAL=$P(LRTRES,U,1)
S LRNOFL="",LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";"_1,0))
Q:LRTST=""
Q:"IN"[$P(^LAB(60,LRTST,0),U,3)
I '$D(^LAB(64.5,"AC",LRSUB)) D MISC Q
K LRNON
D LRMH
I '$D(LRNON) D MISC
Q
;
;
LRMH ;
S LRMH=0
F S LRMH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH)) Q:LRMH<1 D LRSH
Q
;
;
LRSH ;
S LRSH=0
F S LRSH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH)) Q:LRSH<1 D TST
Q
;
;
TST ;
S LRTSTS=0
F S LRTSTS=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH,LRTSTS)) Q:'LRTSTS S LRSPM1=^(LRTSTS) D TST1
Q
;
;
TST1 ;
Q:LRSPM'=LRSPM1
;
SBSET ;
N LRMHN,LRTF
S LRMHN=$P(^LAB(64.5,1,1,LRMH,0),U,1),LRTF=^(1,LRSH,0),$P(LRTF,U,4)=$P(LRTF,U,3),$P(LRTF,U,3)=$P(^(1,0),U,4),LRNON=1
Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD($P(LRTF,"^"))))
;
;** LRTE=Total minor headings
;** LRMHN=Major heading name^TE^Lab performing tests
;** LRTF=Minor header^Profile specimen^Total tests^Type of display
;
S LRIIDT=LRVIDT
S:'$D(^TMP($J,LRDFN,LRMH)) ^(LRMH)=LRMHN
S:'$D(^TMP($J,LRDFN,LRMH,LRSH))!($D(^(LRSH))=10) ^(LRSH)=LRTF_U
S:'$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,0)) ^(0)=LRTLOC_U_LRVIDT_U_LRVDT_U_LRAN_U_LRIDT_U_LREAL
;
LRTSTVAL ;
;
N TST
S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,LRTSTS)=$P(LRTRES,"^")_"^"_$P(LRTRES,"^",2)
S X=$P($G(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRTSTS,0)),"^",3)
I X'="" S ^TMP("LRT",$J,X)=$P(LRTF,"^")
;
; Check for comment on specimen and put in TMP global on first pass
I $D(^LR(LRDFN,"CH",LRIDT,1,0)),'$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",0)) D TEXT
;
; Check if individual result's unit/normals different from test units/normals
I $P(LRTRES,"^")'?1(1"pending",1"comment",1"canc") D CHKUN
;
S TST=$S($P($G(^LAB(60,LRTST,.1)),"^")'="":$P(^(.1),"^"),1:$P(^LAB(60,LRTST,0),"^"))
I $O(^LAB(60,LRTST,1,LRSPM,1,0)),'$D(^TMP($J,"EVAL",LRTST,LRSPM)) D
. S ^TMP($J,"EVAL",LRTST,LRSPM)=""
. N I,L,X
. S I=0
. S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1,^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Evaluation for "_TST_":"
. F S I=$O(^LAB(60,LRTST,1,LRSPM,1,I)) Q:'I S X=^(I,0) S L=L+1,^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=X
. S ^TMP("LRCMTINDX",$J,LRIDT)=""
;
; Save performing lab ien in list
I $P(LRTRES,U,6) S ^TMP("LRPLS",$J,LRMH,LRSH,$P(LRTRES,U,6),TST)="",^TMP("LRCMTINDX",$J,LRIDT)=""
Q
;
;
MISC ;
Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD("MISCELLANEOUS TESTS")))
S LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";"_1,0))
Q:LRTST=""
Q:"IN"[$P(^LAB(60,LRTST,0),U,3)
N LRTOP,TST
S LRTOP=LRSPM
;
S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,0)) ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN_U_LRSPM_U_LREAL
S ^TMP($J,LRDFN,"MISC",LRIDT,LRTNN)=$P(LRTRES,"^")_U_LRSPM_U_LRTST_U_$P(LRTRES,"^",2)_U_LRSUB_U_$P(LRTRES,"^",3,6)
;
S TST=$P($G(^LAB(60,LRTST,.1)),"^")
I TST="" S TST=$P(^LAB(60,LRTST,0),"^")
S ^TMP("LRT",$J,TST)="MISCELLANEOUS TESTS"
;
; Grab specimen comments
D GSC
;
; Grab test interpretation
I $O(^LAB(60,LRTST,1,LRSPM,1,0)) D
. N I,L,X
. S I=0
. S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)) ^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)=""
. S L=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),L=L+1
. S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)="Evaluation for "_TST_":"
. F S I=$O(^LAB(60,LRTST,1,LRSPM,1,I)) Q:'I S X=^(I,0) S L=L+1,^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=X
;
; Save performing lab ien in list
I $P(LRTRES,U,6) S ^TMP("LRPLS",$J,"MISC",$P(LRTRES,U,6),TST)=""
;
S LRTNN=LRTNN+1
Q
;
;
TEXT ;
N LRYESCOM,M,N
S LRYESCOM=0
S M=0
F S M=$O(^LR(LRDFN,"CH",LRIDT,1,M)) Q:M<1!(LRYESCOM) F N=1:1:$L(^LR(LRDFN,"CH",LRIDT,1,M,0)) Q:LRYESCOM S:$E(^(0),N)'[$C(32) LRYESCOM=1
Q:'LRYESCOM
S L=0
F S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:L<1 S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
S ^TMP("LRCMTINDX",$J,LRIDT)=""
Q
;
;
MICRO ;from LR7OSUM
Q:'$D(^LR(LRDFN,"MI"))
N GIOM,MICROCNT
S GIOM=$G(LRGIOM)
I GIOM="" D
. S GIOM=$$GET^XPAR("USR^DIV^PKG","LR MI GUI REPORT RIGHT MARGIN",1,"Q")
. I GIOM="" S GIOM=80
S:'$D(LRUNKNOW) LRUNKNOW=$P(^LAB(69.9,1,1),U,5)
S (LRONESPC,LRONETST)="",LREND=0,MICROCNT=GCNT+1
I $O(^LR(LRDFN,"MI",0)) S ^TMP("LRH",$J,"MICROBIOLOGY")=MICROCNT
S LRWRDVEW="",LRSB=0,LRIDT=LRIN
F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1!(LRIDT>LROUT)!(CT1>COUNT) D
. N LRX
. ;
. S LRNLOC=LRLLOC
. S CT1=CT1+1
. ;
. D EN1^LR7OSMZ0
. ;
. D LN^LR7OSMZ1
. S LRX="=",^TMP("LRC",$J,GCNT,0)=$$REPEAT^XLFSTR(LRX,GIOM/$L(LRX))
. D LN^LR7OSMZ1
. S ^TMP("LRC",$J,GCNT,0)=""
. ;
. S LRLLOC=LRNLOC
I GCNT'>MICROCNT K ^TMP("LRH",$J,"MICROBIOLOGY")
K %,A,A1,AGE,B,B1,DFN,DOB,DZ,I,J,LR2ORMOR,LRAA,LRACC,LRACN,LRAD,LRADM,LRADX,LRAFS,LRAX,LRBUG,LRCMNT,LRCS,LRDCOM,LREF,LREND,LRIFN,LRLLT,LRMD,LRNLOC,LRNS,LROK,LRONESPC,LRONETST,LRORG,LRPRE,LRPRINT
Q
;
;
CHKUN ; Check units and normals with cumulative report values
; Add comment if these differ from file #64.5 values
;
N I,L,LRFLAG,LRHI,LRLO,LRLOHI,LRX,LRY,TST,TXT
S LRX=$G(^LAB(64.5,"A",1,LRMH,LRSH,LRTSTS)),LRFLAG=0
S TST=$P($G(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRTSTS,0)),"^",3)
S LRY="*** For test "_TST
; Check units - if different generate comment
I $$UP^XLFSTR($P(LRX,"^",7))'=$$UP^XLFSTR($P(LRTRES,"^",5)) S LRY=LRY_" Units: "_$S($P(LRTRES,"^",5)'="":$P(LRTRES,"^",5),1:"<none specified>"),LRFLAG=1
;
; Check normals - if different generate comment
S @("LRLO="_$S($P(LRX,"^",2)'="":$P(LRX,"^",2),$P(LRX,"^",11)'="":$P(LRX,"^",11),1:""""""))
;
S @("LRHI="_$S($P(LRX,"^",3)'="":$P(LRX,"^",3),$P(LRX,"^",12)'="":$P(LRX,"^",12),1:""""""))
I LRLO'=$P(LRTRES,"^",3)!(LRHI'=$P(LRTRES,"^",4)) D
. I '$$REALDIFF Q
. I LRFLAG S LRY=LRY_" and"
. S TXT=""
. D
. . I $P(LRTRES,"^",3)="",$P(LRTRES,"^",4)="" S TXT="<none specified>" Q
. . I $P(LRTRES,"^",3)'="",$P(LRTRES,"^",4)'="" S TXT=$P(LRTRES,"^",3)_" to "_$P(LRTRES,"^",4) Q
. . I $P(LRTRES,"^",3)'="",$P(LRTRES,"^",4)="" S TXT=$S($P(LRTRES,"^",3)?.AP:$P(LRTRES,"^",3),1:"low: "_$P(LRTRES,"^",3)) Q
. . I $P(LRTRES,"^",3)="",$P(LRTRES,"^",4)'="" S TXT=$S($P(LRTRES,"^",4)?.AP:$P(LRTRES,"^",4),1:"high: "_$P(LRTRES,"^",4)) Q
. I TXT'="" S LRY=LRY_" Normals: "_TXT,LRFLAG=1
;
I 'LRFLAG Q
;
S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1
S LRY=LRY_" ***",^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=LRY
S ^TMP("LRCMTINDX",$J,LRIDT)=""
Q
;
;
REALDIFF() ;
; function to determine if values are numeric and are different
; solely because of leading or trailing zeroes
; returns 0 if difference is because of leading/trailing zeroes
; returns 1 if differences are meaningful
N LRTRESLO,LRTRESHI,DIFF
S LRTRESLO=$P(LRTRES,"^",3),LRTRESHI=$P(LRTRES,"^",4)
S DIFF=0
I LRLO'=LRTRESLO S DIFF=1 D
. I LRLO?.N!(LRLO?.N1".".N) D
. . I LRTRESLO?.N!(LRTRESLO?.N1".".N) D
. . . I +LRLO=+LRTRESLO S DIFF=0
I DIFF Q 1
I LRHI'=LRTRESHI S DIFF=1 D
. I LRHI?.N!(LRHI?.N1".".N) D
. . I LRTRESHI?.N!(LRTRESHI?.N1".".N) D
. . . I +LRHI=+LRTRESHI S DIFF=0
I DIFF Q 1
Q 0
;
;
GSC ; Grab specimen comments
;
I $D(^LR(LRDFN,"CH",LRIDT,1,0)),'$D(^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)) D
. S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)="",L=0
. F S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:L<1 S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
;
Q
;
;
CHKNP ; Check for NP comments and no verified results.
;
;
N LRCAN,TST
; Don't print unverified results.
I $O(^LR(LRDFN,"CH",LRIDT,1)) Q
;
S LRCAN=0
F S LRCAN=+$O(^LR(LRDFN,"CH",LRIDT,1,LRCAN)) Q:LRCAN<1 Q:($E(^(LRCAN,0))="*")
;
; Print if cancel comment and no unverified results.
I LRCAN<1 Q
;
Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD("MISCELLANEOUS TESTS")))
;
S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,0)) ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN_U_LRSPM_U_LREAL
S ^TMP($J,LRDFN,"MISC",LRIDT,LRTNN)=""_U_LRSPM_U
;
S TST="See comment"
S ^TMP("LRT",$J,TST)="MISCELLANEOUS TESTS"
;
; Grab specimen comments
D GSC
;
S LRTNN=LRTNN+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSUM1 9489 printed Jan 18, 2025@03:06:24 Page 2
LR7OSUM1 ;DALOI/staff - Silent Patient cum cont. ;06/03/13 11:17
+1 ;;5.2;LAB SERVICE;**121,187,256,286,384,350,427**;Sep 27, 1994;Build 33
+2 ;
LRIDT ; from LR7OSUM
+1 NEW GIOM,LRDRL
+2 SET GIOM=$GET(LRGIOM)
+3 IF GIOM=""
Begin DoDot:1
+4 SET GIOM=$$GET^XPAR("USR^DIV^PKG","LR CH GUI REPORT RIGHT MARGIN",1,"Q")
+5 IF GIOM=""
SET GIOM=80
End DoDot:1
+6 KILL ^TMP("LRPLS",$JOB),^TMP("LRPLS-ADDR",$JOB),^TMP("LRCMTINDX",$JOB)
+7 ;
+8 ; Flag to determine if reporting laboratory is printed on report
+9 SET LRDRL=$$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
+10 ;
+11 FOR
SET LRIDT=$ORDER(^LR(LRDFN,"CH",LRIDT))
if LRIDT<1!(LRIDT>LROUT)!(CT1>COUNT)
QUIT
IF $DATA(^(LRIDT,0))
SET X=^(0)
SET CT1=CT1+1
DO LRIIDT
+12 DO CMTINDX^LR7OSUM2
+13 QUIT
+14 ;
+15 ;
LRIIDT ;
+1 NEW LRIIDT,LRAN,LRPROV,LREAL,LRSPM,LRSPM1,LRSUB,LRTLOC,LRTNN,LRTST,LRTSTS,LRVDT,LRVIDT
+2 SET (LRIIDT,LRVIDT)=$PIECE(X,U,1)
SET LREAL=$PIECE(X,U,2)
SET LRSUB=1
SET LRTNN=1
SET LRSPM=$PIECE(X,U,5)
SET LRTLOC=$EXTRACT($PIECE(X,U,11),1,7)
SET LRVDT=$PIECE(X,U,3)
SET LRAN=$PIECE(X,U,6)
SET LRPROV=$PIECE(X,U,10)
+3 ;
+4 IF LRVDT
Begin DoDot:1
+5 DO LRSUB
DO ORDBY^LR7OSUM2
DO RELDT^LR7OSUM2
+6 IF LRDRL
DO RL^LR7OSUM2
+7 DO PLS^LR7OSUM2
End DoDot:1
QUIT
+8 ;
+9 IF LRVDT=""
Begin DoDot:1
+10 DO CHKNP
DO ORDBY^LR7OSUM2
+11 IF LRDRL
DO RL^LR7OSUM2
+12 NEW OUTCNT
+13 SET OUTCNT=+$ORDER(^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",9999999),-1)
SET OUTCNT=OUTCNT+1
+14 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" "
End DoDot:1
+15 ;
+16 QUIT
+17 ;
+18 ;
LRSUB ;
+1 NEW LRTRES
+2 SET LRSUB=1
+3 FOR
SET LRSUB=$ORDER(^LR(LRDFN,"CH",LRIDT,LRSUB))
if LRSUB<1
QUIT
Begin DoDot:1
+4 SET X=^LR(LRDFN,"CH",LRIDT,LRSUB)
+5 SET LRTRES=$$TSTRES^LRRPU(LRDFN,"CH",LRIDT,LRSUB,"")
+6 IF $PIECE(LRTRES,"^",1)=""
QUIT
+7 DO SUB1
End DoDot:1
+8 QUIT
+9 ;
+10 ;
SUB1 ;
+1 NEW LRNOFL,LRTSTVAL
+2 SET LRTSTVAL=$PIECE(LRTRES,U,1)
+3 SET LRNOFL=""
SET LRTST=$ORDER(^LAB(60,"C","CH;"_LRSUB_";"_1,0))
+4 if LRTST=""
QUIT
+5 if "IN"[$PIECE(^LAB(60,LRTST,0),U,3)
QUIT
+6 IF '$DATA(^LAB(64.5,"AC",LRSUB))
DO MISC
QUIT
+7 KILL LRNON
+8 DO LRMH
+9 IF '$DATA(LRNON)
DO MISC
+10 QUIT
+11 ;
+12 ;
LRMH ;
+1 SET LRMH=0
+2 FOR
SET LRMH=$ORDER(^LAB(64.5,"AC",LRSUB,1,LRMH))
if LRMH<1
QUIT
DO LRSH
+3 QUIT
+4 ;
+5 ;
LRSH ;
+1 SET LRSH=0
+2 FOR
SET LRSH=$ORDER(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH))
if LRSH<1
QUIT
DO TST
+3 QUIT
+4 ;
+5 ;
TST ;
+1 SET LRTSTS=0
+2 FOR
SET LRTSTS=$ORDER(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH,LRTSTS))
if 'LRTSTS
QUIT
SET LRSPM1=^(LRTSTS)
DO TST1
+3 QUIT
+4 ;
+5 ;
TST1 ;
+1 if LRSPM'=LRSPM1
QUIT
+2 ;
SBSET ;
+1 NEW LRMHN,LRTF
+2 SET LRMHN=$PIECE(^LAB(64.5,1,1,LRMH,0),U,1)
SET LRTF=^(1,LRSH,0)
SET $PIECE(LRTF,U,4)=$PIECE(LRTF,U,3)
SET $PIECE(LRTF,U,3)=$PIECE(^(1,0),U,4)
SET LRNON=1
+3 if $SELECT('$DATA(SUBHEAD)
QUIT
+4 ;
+5 ;** LRTE=Total minor headings
+6 ;** LRMHN=Major heading name^TE^Lab performing tests
+7 ;** LRTF=Minor header^Profile specimen^Total tests^Type of display
+8 ;
+9 SET LRIIDT=LRVIDT
+10 if '$DATA(^TMP($JOB,LRDFN,LRMH))
SET ^(LRMH)=LRMHN
+11 if '$DATA(^TMP($JOB,LRDFN,LRMH,LRSH))!($DATA(^(LRSH))=10)
SET ^(LRSH)=LRTF_U
+12 if '$DATA(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,0))
SET ^(0)=LRTLOC_U_LRVIDT_U_LRVDT_U_LRAN_U_LRIDT_U_LREAL
+13 ;
LRTSTVAL ;
+1 ;
+2 NEW TST
+3 SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,LRTSTS)=$PIECE(LRTRES,"^")_"^"_$PIECE(LRTRES,"^",2)
+4 SET X=$PIECE($GET(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRTSTS,0)),"^",3)
+5 IF X'=""
SET ^TMP("LRT",$JOB,X)=$PIECE(LRTF,"^")
+6 ;
+7 ; Check for comment on specimen and put in TMP global on first pass
+8 IF $DATA(^LR(LRDFN,"CH",LRIDT,1,0))
IF '$DATA(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",0))
DO TEXT
+9 ;
+10 ; Check if individual result's unit/normals different from test units/normals
+11 IF $PIECE(LRTRES,"^")'?1(1"pending",1"comment",1"canc")
DO CHKUN
+12 ;
+13 SET TST=$SELECT($PIECE($GET(^LAB(60,LRTST,.1)),"^")'="":$PIECE(^(.1),"^"),1:$PIECE(^LAB(60,LRTST,0),"^"))
+14 IF $ORDER(^LAB(60,LRTST,1,LRSPM,1,0))
IF '$DATA(^TMP($JOB,"EVAL",LRTST,LRSPM))
Begin DoDot:1
+15 SET ^TMP($JOB,"EVAL",LRTST,LRSPM)=""
+16 NEW I,L,X
+17 SET I=0
+18 SET L=+$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1)
SET L=L+1
SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Evaluation for "_TST_":"
+19 FOR
SET I=$ORDER(^LAB(60,LRTST,1,LRSPM,1,I))
if 'I
QUIT
SET X=^(I,0)
SET L=L+1
SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=X
+20 SET ^TMP("LRCMTINDX",$JOB,LRIDT)=""
End DoDot:1
+21 ;
+22 ; Save performing lab ien in list
+23 IF $PIECE(LRTRES,U,6)
SET ^TMP("LRPLS",$JOB,LRMH,LRSH,$PIECE(LRTRES,U,6),TST)=""
SET ^TMP("LRCMTINDX",$JOB,LRIDT)=""
+24 QUIT
+25 ;
+26 ;
MISC ;
+1 if $SELECT('$DATA(SUBHEAD)
QUIT
+2 SET LRTST=$ORDER(^LAB(60,"C","CH;"_LRSUB_";"_1,0))
+3 if LRTST=""
QUIT
+4 if "IN"[$PIECE(^LAB(60,LRTST,0),U,3)
QUIT
+5 NEW LRTOP,TST
+6 SET LRTOP=LRSPM
+7 ;
+8 if '$DATA(^TMP($JOB,LRDFN,"MISC",LRIDT,0))
SET ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN_U_LRSPM_U_LREAL
+9 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,LRTNN)=$PIECE(LRTRES,"^")_U_LRSPM_U_LRTST_U_$PIECE(LRTRES,"^",2)_U_LRSUB_U_$PIECE(LRTRES,"^",3,6)
+10 ;
+11 SET TST=$PIECE($GET(^LAB(60,LRTST,.1)),"^")
+12 IF TST=""
SET TST=$PIECE(^LAB(60,LRTST,0),"^")
+13 SET ^TMP("LRT",$JOB,TST)="MISCELLANEOUS TESTS"
+14 ;
+15 ; Grab specimen comments
+16 DO GSC
+17 ;
+18 ; Grab test interpretation
+19 IF $ORDER(^LAB(60,LRTST,1,LRSPM,1,0))
Begin DoDot:1
+20 NEW I,L,X
+21 SET I=0
+22 if '$DATA(^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",0))
SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",0)=""
+23 SET L=+$ORDER(^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",9999999),-1)
SET L=L+1
+24 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",L,0)="Evaluation for "_TST_":"
+25 FOR
SET I=$ORDER(^LAB(60,LRTST,1,LRSPM,1,I))
if 'I
QUIT
SET X=^(I,0)
SET L=L+1
SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",L,0)=X
End DoDot:1
+26 ;
+27 ; Save performing lab ien in list
+28 IF $PIECE(LRTRES,U,6)
SET ^TMP("LRPLS",$JOB,"MISC",$PIECE(LRTRES,U,6),TST)=""
+29 ;
+30 SET LRTNN=LRTNN+1
+31 QUIT
+32 ;
+33 ;
TEXT ;
+1 NEW LRYESCOM,M,N
+2 SET LRYESCOM=0
+3 SET M=0
+4 FOR
SET M=$ORDER(^LR(LRDFN,"CH",LRIDT,1,M))
if M<1!(LRYESCOM)
QUIT
FOR N=1:1:$LENGTH(^LR(LRDFN,"CH",LRIDT,1,M,0))
if LRYESCOM
QUIT
if $EXTRACT(^(0),N)'[$CHAR(32)
SET LRYESCOM=1
+5 if 'LRYESCOM
QUIT
+6 SET L=0
+7 FOR
SET L=$ORDER(^LR(LRDFN,"CH",LRIDT,1,L))
if L<1
QUIT
SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
+8 SET ^TMP("LRCMTINDX",$JOB,LRIDT)=""
+9 QUIT
+10 ;
+11 ;
MICRO ;from LR7OSUM
+1 if '$DATA(^LR(LRDFN,"MI"))
QUIT
+2 NEW GIOM,MICROCNT
+3 SET GIOM=$GET(LRGIOM)
+4 IF GIOM=""
Begin DoDot:1
+5 SET GIOM=$$GET^XPAR("USR^DIV^PKG","LR MI GUI REPORT RIGHT MARGIN",1,"Q")
+6 IF GIOM=""
SET GIOM=80
End DoDot:1
+7 if '$DATA(LRUNKNOW)
SET LRUNKNOW=$PIECE(^LAB(69.9,1,1),U,5)
+8 SET (LRONESPC,LRONETST)=""
SET LREND=0
SET MICROCNT=GCNT+1
+9 IF $ORDER(^LR(LRDFN,"MI",0))
SET ^TMP("LRH",$JOB,"MICROBIOLOGY")=MICROCNT
+10 SET LRWRDVEW=""
SET LRSB=0
SET LRIDT=LRIN
+11 FOR
SET LRIDT=$ORDER(^LR(LRDFN,"MI",LRIDT))
if LRIDT<1!(LRIDT>LROUT)!(CT1>COUNT)
QUIT
Begin DoDot:1
+12 NEW LRX
+13 ;
+14 SET LRNLOC=LRLLOC
+15 SET CT1=CT1+1
+16 ;
+17 DO EN1^LR7OSMZ0
+18 ;
+19 DO LN^LR7OSMZ1
+20 SET LRX="="
SET ^TMP("LRC",$JOB,GCNT,0)=$$REPEAT^XLFSTR(LRX,GIOM/$LENGTH(LRX))
+21 DO LN^LR7OSMZ1
+22 SET ^TMP("LRC",$JOB,GCNT,0)=""
+23 ;
+24 SET LRLLOC=LRNLOC
End DoDot:1
+25 IF GCNT'>MICROCNT
KILL ^TMP("LRH",$JOB,"MICROBIOLOGY")
+26 KILL %,A,A1,AGE,B,B1,DFN,DOB,DZ,I,J,LR2ORMOR,LRAA,LRACC,LRACN,LRAD,LRADM,LRADX,LRAFS,LRAX,LRBUG,LRCMNT,LRCS,LRDCOM,LREF,LREND,LRIFN,LRLLT,LRMD,LRNLOC,LRNS,LROK,LRONESPC,LRONETST,LRORG,LRPRE,LRPRINT
+27 QUIT
+28 ;
+29 ;
CHKUN ; Check units and normals with cumulative report values
+1 ; Add comment if these differ from file #64.5 values
+2 ;
+3 NEW I,L,LRFLAG,LRHI,LRLO,LRLOHI,LRX,LRY,TST,TXT
+4 SET LRX=$GET(^LAB(64.5,"A",1,LRMH,LRSH,LRTSTS))
SET LRFLAG=0
+5 SET TST=$PIECE($GET(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRTSTS,0)),"^",3)
+6 SET LRY="*** For test "_TST
+7 ; Check units - if different generate comment
+8 IF $$UP^XLFSTR($PIECE(LRX,"^",7))'=$$UP^XLFSTR($PIECE(LRTRES,"^",5))
SET LRY=LRY_" Units: "_$SELECT($PIECE(LRTRES,"^",5)'="":$PIECE(LRTRES,"^",5),1:"<none specified>")
SET LRFLAG=1
+9 ;
+10 ; Check normals - if different generate comment
+11 SET @("LRLO="_$SELECT($PIECE(LRX,"^",2)'="":$PIECE(LRX,"^",2),$PIECE(LRX,"^",11)'="":$PIECE(LRX,"^",11),1:""""""))
+12 ;
+13 SET @("LRHI="_$SELECT($PIECE(LRX,"^",3)'="":$PIECE(LRX,"^",3),$PIECE(LRX,"^",12)'="":$PIECE(LRX,"^",12),1:""""""))
+14 IF LRLO'=$PIECE(LRTRES,"^",3)!(LRHI'=$PIECE(LRTRES,"^",4))
Begin DoDot:1
+15 IF '$$REALDIFF
QUIT
+16 IF LRFLAG
SET LRY=LRY_" and"
+17 SET TXT=""
+18 Begin DoDot:2
+19 IF $PIECE(LRTRES,"^",3)=""
IF $PIECE(LRTRES,"^",4)=""
SET TXT="<none specified>"
QUIT
+20 IF $PIECE(LRTRES,"^",3)'=""
IF $PIECE(LRTRES,"^",4)'=""
SET TXT=$PIECE(LRTRES,"^",3)_" to "_$PIECE(LRTRES,"^",4)
QUIT
+21 IF $PIECE(LRTRES,"^",3)'=""
IF $PIECE(LRTRES,"^",4)=""
SET TXT=$SELECT($PIECE(LRTRES,"^",3)?.AP:$PIECE(LRTRES,"^",3),1:"low: "_$PIECE(LRTRES,"^",3))
QUIT
+22 IF $PIECE(LRTRES,"^",3)=""
IF $PIECE(LRTRES,"^",4)'=""
SET TXT=$SELECT($PIECE(LRTRES,"^",4)?.AP:$PIECE(LRTRES,"^",4),1:"high: "_$PIECE(LRTRES,"^",4))
QUIT
End DoDot:2
+23 IF TXT'=""
SET LRY=LRY_" Normals: "_TXT
SET LRFLAG=1
End DoDot:1
+24 ;
+25 IF 'LRFLAG
QUIT
+26 ;
+27 SET L=+$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1)
SET L=L+1
+28 SET LRY=LRY_" ***"
SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=LRY
+29 SET ^TMP("LRCMTINDX",$JOB,LRIDT)=""
+30 QUIT
+31 ;
+32 ;
REALDIFF() ;
+1 ; function to determine if values are numeric and are different
+2 ; solely because of leading or trailing zeroes
+3 ; returns 0 if difference is because of leading/trailing zeroes
+4 ; returns 1 if differences are meaningful
+5 NEW LRTRESLO,LRTRESHI,DIFF
+6 SET LRTRESLO=$PIECE(LRTRES,"^",3)
SET LRTRESHI=$PIECE(LRTRES,"^",4)
+7 SET DIFF=0
+8 IF LRLO'=LRTRESLO
SET DIFF=1
Begin DoDot:1
+9 IF LRLO?.N!(LRLO?.N1".".N)
Begin DoDot:2
+10 IF LRTRESLO?.N!(LRTRESLO?.N1".".N)
Begin DoDot:3
+11 IF +LRLO=+LRTRESLO
SET DIFF=0
End DoDot:3
End DoDot:2
End DoDot:1
+12 IF DIFF
QUIT 1
+13 IF LRHI'=LRTRESHI
SET DIFF=1
Begin DoDot:1
+14 IF LRHI?.N!(LRHI?.N1".".N)
Begin DoDot:2
+15 IF LRTRESHI?.N!(LRTRESHI?.N1".".N)
Begin DoDot:3
+16 IF +LRHI=+LRTRESHI
SET DIFF=0
End DoDot:3
End DoDot:2
End DoDot:1
+17 IF DIFF
QUIT 1
+18 QUIT 0
+19 ;
+20 ;
GSC ; Grab specimen comments
+1 ;
+2 IF $DATA(^LR(LRDFN,"CH",LRIDT,1,0))
IF '$DATA(^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",0))
Begin DoDot:1
+3 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",0)=""
SET L=0
+4 FOR
SET L=$ORDER(^LR(LRDFN,"CH",LRIDT,1,L))
if L<1
QUIT
SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
End DoDot:1
+5 ;
+6 QUIT
+7 ;
+8 ;
CHKNP ; Check for NP comments and no verified results.
+1 ;
+2 ;
+3 NEW LRCAN,TST
+4 ; Don't print unverified results.
+5 IF $ORDER(^LR(LRDFN,"CH",LRIDT,1))
QUIT
+6 ;
+7 SET LRCAN=0
+8 FOR
SET LRCAN=+$ORDER(^LR(LRDFN,"CH",LRIDT,1,LRCAN))
if LRCAN<1
QUIT
if ($EXTRACT(^(LRCAN,0))="*")
QUIT
+9 ;
+10 ; Print if cancel comment and no unverified results.
+11 IF LRCAN<1
QUIT
+12 ;
+13 if $SELECT('$DATA(SUBHEAD)
QUIT
+14 ;
+15 if '$DATA(^TMP($JOB,LRDFN,"MISC",LRIDT,0))
SET ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN_U_LRSPM_U_LREAL
+16 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,LRTNN)=""_U_LRSPM_U
+17 ;
+18 SET TST="See comment"
+19 SET ^TMP("LRT",$JOB,TST)="MISCELLANEOUS TESTS"
+20 ;
+21 ; Grab specimen comments
+22 DO GSC
+23 ;
+24 SET LRTNN=LRTNN+1
+25 QUIT
