LR7OSUM6 ;DALOI/STAFF - Silent Patient cum cont. ;Nov 12, 2008
;;5.2;LAB SERVICE;**121,201,187,286,356,372,350**;Sep 27, 1994;Build 230
;
LRUDT(LRDATE,LREAL) ;Get output date/time
; Call with LRDATE = FileMan date/time
; LREAL = flag indicating inexact date/time (LREAL=1)
; Called from below, LR7OGMP, LR7OSUM3
N LRUDT
;S LRTIM=$E(X,9,12) F I=0:0 Q:$L(LRTIM)=4 S LRTIM=LRTIM_0
;S LRTIM=$S(LRTIM?4"0":" ",1:$E(LRTIM,1,2)_":"_$E(LRTIM,3,4)),LRUDT=$$FMTE^XLFDT($P(X,"."),"5Z")_" "_$J(LRTIM,5)_" "
S LRUDT=$$FMTE^XLFDT(LRDATE,"1"_$S(LREAL:"D",1:"M"))
Q LRUDT
;
;
HEAD ;from LR7OSUM3, LR7OSUM4, LR7OSUM5
D LRBOT,TOP
Q
;
;
LRBOT ;from LR7OSUM3
N L1 D LINE^LR7OSUM4
Y D LINE^LR7OSUM4
Q
;
;
TOP ; from LR7OSUM3
S LRAG=0
Q
;
;
KILL ;
D HEAD
Q
;
;
LRMISC S LRFDT=0,LRPG=1 D TOP
;
MHI ;
S LRMHN=$P(^TMP($J,LRDFN,LRMH),U,1),LRCNT=12 D WR
;
;
MDT S LRFDT=$O(^TMP($J,LRDFN,"MISC",LRFDT)) G:LRFDT<1 END
S LRUDT=$$LRUDT(9999999-LRFDT,+$P($G(^TMP($J,LRDFN,"MISC",LRFDT,0)),U,6))
D LRCNT S LRMIT=0
;
LRMIT S LRMIT=$O(^TMP($J,LRDFN,"MISC",LRFDT,LRMIT)) G:LRMIT="TX" TXT G:LRMIT="" MDT S X=^(LRMIT) G:LRMIT=.1 MSG
;
S LRVAL=$P(X,U,1),LRSPE=$P(X,U,2),LRTEST=$P(X,U,3),X1=$P(X,U,4)
S LRLO=$P(X,"^",6),LRHI=$P(X,"^",7),LRUNT=$P(X,"^",8)
S LRSPEM=$S($L(LRSPE):$P(^LAB(61,LRSPE,0),U,1),1:"")
;G:'LRTEST COMM
S LRNAME=""
I LRTEST D
. S LRNAME=$P(^LAB(60,LRTEST,0),"^")
. I $L(LRNAME)>25,$P($G(^LAB(60,LRTEST,.1)),"^")'="" S LRNAME=$P(^LAB(60,LRTEST,.1),"^")
. E S LRNAME=$E(LRNAME,1,25)
;
D LINE^LR7OSUM4
S LRREF=$$EN^LRLRRVF(LRLO,LRHI)
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LRUDT)_$$S^LR7OS(21,CCNT,$E(LRSPEM,1,16))_$$S^LR7OS(40,CCNT,LRNAME_":")_$$S^LR7OS(65,CCNT,LRVAL_" "_X1_" "_LRUNT)_$$S^LR7OS(82,CCNT,LRREF)
I LRNAME'="",'$P($G(^TMP("LRT",$J,LRNAME)),"^",2) S $P(^(LRNAME),"^",2)=GCNT
K LRREF
I 'LRTEST G COMM
G LRMIT
;
;
MSG D LINE^LR7OSUM4,LINE^LR7OSUM4
X X ;Need to see what is in X
G LRMIT
;
;
COMM D LN
I LRVAL'="" S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"COMMENT: "_LRVAL)
G LRMIT
;
;
WR ;
D LINE^LR7OSUM4
S X=GIOM/2-($L(LRMHN)/2+5)
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(X,CCNT,"---- "_LRMHN_" ----"),^TMP("LRH",$J,LRMHN)=GCNT
D LINE^LR7OSUM4
D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(4,CCNT,"DATE TIME SPECIMEN")_$$S^LR7OS(40,CCNT,"TEST")_$$S^LR7OS(65,CCNT,"VALUE")_$$S^LR7OS(79,CCNT,"Ref ranges")
D LN S X="",$P(X,"-",GIOM)="",^TMP("LRC",$J,GCNT,0)=X
Q
;
;
TXT S I=0
F S I=$O(^TMP($J,LRDFN,"MISC",LRFDT,"TX",I)) Q:I<1 S GCNT=GCNT+1,^TMP("LRC",$J,GCNT,0)=^(I,0)
G LRMIT
;
;
END S X="",$P(X,"=",GIOM)="",GCNT=GCNT+1,^TMP("LRC",$J,GCNT,0)=X
D LRBOT S LRLO=""
K LRSB,LRMISC
Q
;
;
PRE ;from LR7OSUM3
Q:$D(^TMP($J,LRDFN,"MISC"))'=11
S LRMISC=1,LRPG=0,LRMH="MISC"
G LRMISC
;
;
LRCNT ;
S LRCNT=0,I=0
F S I=$O(^TMP($J,LRDFN,LRMH,LRFDT,I)) Q:I<1 S LRCNT=LRCNT+1
S LRCTN=0
I $D(^TMP($J,LRDFN,LRMH,LRFDT,"TX")) D
. S J=0
. F S J=$O(^TMP($J,LRDFN,LRMH,LRFDT,"TX",J)) Q:J<1 S LRCTN=LRCTN+1
S LRCNT=LRCNT*2+5+LRCTN
Q
;
;
LN ;
S CCNT=1,GCNT=GCNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSUM6 3166 printed Apr 09, 2024@21:19:30 Page 2
LR7OSUM6 ;DALOI/STAFF - Silent Patient cum cont. ;Nov 12, 2008
+1 ;;5.2;LAB SERVICE;**121,201,187,286,356,372,350**;Sep 27, 1994;Build 230
+2 ;
LRUDT(LRDATE,LREAL) ;Get output date/time
+1 ; Call with LRDATE = FileMan date/time
+2 ; LREAL = flag indicating inexact date/time (LREAL=1)
+3 ; Called from below, LR7OGMP, LR7OSUM3
+4 NEW LRUDT
+5 ;S LRTIM=$E(X,9,12) F I=0:0 Q:$L(LRTIM)=4 S LRTIM=LRTIM_0
+6 ;S LRTIM=$S(LRTIM?4"0":" ",1:$E(LRTIM,1,2)_":"_$E(LRTIM,3,4)),LRUDT=$$FMTE^XLFDT($P(X,"."),"5Z")_" "_$J(LRTIM,5)_" "
+7 SET LRUDT=$$FMTE^XLFDT(LRDATE,"1"_$SELECT(LREAL:"D",1:"M"))
+8 QUIT LRUDT
+9 ;
+10 ;
HEAD ;from LR7OSUM3, LR7OSUM4, LR7OSUM5
+1 DO LRBOT
DO TOP
+2 QUIT
+3 ;
+4 ;
LRBOT ;from LR7OSUM3
+1 NEW L1
DO LINE^LR7OSUM4
Y DO LINE^LR7OSUM4
+1 QUIT
+2 ;
+3 ;
TOP ; from LR7OSUM3
+1 SET LRAG=0
+2 QUIT
+3 ;
+4 ;
KILL ;
+1 DO HEAD
+2 QUIT
+3 ;
+4 ;
LRMISC SET LRFDT=0
SET LRPG=1
DO TOP
+1 ;
MHI ;
+1 SET LRMHN=$PIECE(^TMP($JOB,LRDFN,LRMH),U,1)
SET LRCNT=12
DO WR
+2 ;
+3 ;
MDT SET LRFDT=$ORDER(^TMP($JOB,LRDFN,"MISC",LRFDT))
if LRFDT<1
GOTO END
+1 SET LRUDT=$$LRUDT(9999999-LRFDT,+$PIECE($GET(^TMP($JOB,LRDFN,"MISC",LRFDT,0)),U,6))
+2 DO LRCNT
SET LRMIT=0
+3 ;
LRMIT SET LRMIT=$ORDER(^TMP($JOB,LRDFN,"MISC",LRFDT,LRMIT))
if LRMIT="TX"
GOTO TXT
if LRMIT=""
GOTO MDT
SET X=^(LRMIT)
if LRMIT=.1
GOTO MSG
+1 ;
+2 SET LRVAL=$PIECE(X,U,1)
SET LRSPE=$PIECE(X,U,2)
SET LRTEST=$PIECE(X,U,3)
SET X1=$PIECE(X,U,4)
+3 SET LRLO=$PIECE(X,"^",6)
SET LRHI=$PIECE(X,"^",7)
SET LRUNT=$PIECE(X,"^",8)
+4 SET LRSPEM=$SELECT($LENGTH(LRSPE):$PIECE(^LAB(61,LRSPE,0),U,1),1:"")
+5 ;G:'LRTEST COMM
+6 SET LRNAME=""
+7 IF LRTEST
Begin DoDot:1
+8 SET LRNAME=$PIECE(^LAB(60,LRTEST,0),"^")
+9 IF $LENGTH(LRNAME)>25
IF $PIECE($GET(^LAB(60,LRTEST,.1)),"^")'=""
SET LRNAME=$PIECE(^LAB(60,LRTEST,.1),"^")
+10 IF '$TEST
SET LRNAME=$EXTRACT(LRNAME,1,25)
End DoDot:1
+11 ;
+12 DO LINE^LR7OSUM4
+13 SET LRREF=$$EN^LRLRRVF(LRLO,LRHI)
+14 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,LRUDT)_$$S^LR7OS(21,CCNT,$EXTRACT(LRSPEM,1,16))_$$S^LR7OS(40,CCNT,LRNAME_":")_$$S^LR7OS(65,CCNT,LRVAL_" "_X1_" "_LRUNT)_$$S^LR7OS(82,CCNT,LRREF)
+15 IF LRNAME'=""
IF '$PIECE($GET(^TMP("LRT",$JOB,LRNAME)),"^",2)
SET $PIECE(^(LRNAME),"^",2)=GCNT
+16 KILL LRREF
+17 IF 'LRTEST
GOTO COMM
+18 GOTO LRMIT
+19 ;
+20 ;
MSG DO LINE^LR7OSUM4
DO LINE^LR7OSUM4
+1 ;Need to see what is in X
XECUTE X
+2 GOTO LRMIT
+3 ;
+4 ;
COMM DO LN
+1 IF LRVAL'=""
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"COMMENT: "_LRVAL)
+2 GOTO LRMIT
+3 ;
+4 ;
WR ;
+1 DO LINE^LR7OSUM4
+2 SET X=GIOM/2-($LENGTH(LRMHN)/2+5)
+3 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(X,CCNT,"---- "_LRMHN_" ----")
SET ^TMP("LRH",$JOB,LRMHN)=GCNT
+4 DO LINE^LR7OSUM4
+5 DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(4,CCNT,"DATE TIME SPECIMEN")_$$S^LR7OS(40,CCNT,"TEST")_$$S^LR7OS(65,CCNT,"VALUE")_$$S^LR7OS(79,CCNT,"Ref ranges")
+6 DO LN
SET X=""
SET $PIECE(X,"-",GIOM)=""
SET ^TMP("LRC",$JOB,GCNT,0)=X
+7 QUIT
+8 ;
+9 ;
TXT SET I=0
+1 FOR
SET I=$ORDER(^TMP($JOB,LRDFN,"MISC",LRFDT,"TX",I))
if I<1
QUIT
SET GCNT=GCNT+1
SET ^TMP("LRC",$JOB,GCNT,0)=^(I,0)
+2 GOTO LRMIT
+3 ;
+4 ;
END SET X=""
SET $PIECE(X,"=",GIOM)=""
SET GCNT=GCNT+1
SET ^TMP("LRC",$JOB,GCNT,0)=X
+1 DO LRBOT
SET LRLO=""
+2 KILL LRSB,LRMISC
+3 QUIT
+4 ;
+5 ;
PRE ;from LR7OSUM3
+1 if $DATA(^TMP($JOB,LRDFN,"MISC"))'=11
QUIT
+2 SET LRMISC=1
SET LRPG=0
SET LRMH="MISC"
+3 GOTO LRMISC
+4 ;
+5 ;
LRCNT ;
+1 SET LRCNT=0
SET I=0
+2 FOR
SET I=$ORDER(^TMP($JOB,LRDFN,LRMH,LRFDT,I))
if I<1
QUIT
SET LRCNT=LRCNT+1
+3 SET LRCTN=0
+4 IF $DATA(^TMP($JOB,LRDFN,LRMH,LRFDT,"TX"))
Begin DoDot:1
+5 SET J=0
+6 FOR
SET J=$ORDER(^TMP($JOB,LRDFN,LRMH,LRFDT,"TX",J))
if J<1
QUIT
SET LRCTN=LRCTN+1
End DoDot:1
+7 SET LRCNT=LRCNT*2+5+LRCTN
+8 QUIT
+9 ;
+10 ;
LN ;
+1 SET CCNT=1
SET GCNT=GCNT+1
+2 QUIT
