LR7OSUM6 ;VA/DALOI/dcm - Silent Patient cum cont. ;JUL 06, 2010 3:14 PM
;;5.2;LAB SERVICE;**121,201,187,286,356,372,1027**;NOV 01, 1997;Build 11
;
LRUDT(X) ;Get output date/time
N LRTIM,I
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)_" "
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
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) 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="",LRHI=","LRUNT=""
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=$P(^LAB(60,LRTEST,.1),U,1)
;S:$L(LRSPE)&($D(^LAB(60,LRTEST,1,LRSPE,0))) X=^(0),@("LRLO="_$S($L($P(X,U,2)):$P(X,U,2),1:"""""")),@("LRHI="_$S($L($P(X,U,3)):$P(X,U,3),1:"""""")),LRUNT=$P(X,U,7)
;
WR1 D LINE^LR7OSUM4
S LRREF=$$EN^LRLRRVF(LRLO,LRHI)
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LRUDT)_$$S^LR7OS(19,CCNT,$E(LRSPEM,1,16))_$$S^LR7OS(37,CCNT,LRNAME_":")_$$S^LR7OS(50,CCNT,LRVAL_" "_X1_" "_LRUNT)_$$S^LR7OS(67,CCNT,LRREF)
S:'$P($G(^TMP("LRT",$J,LRNAME)),"^",2) $P(^(LRNAME),"^",2)=GCNT
K LRREF
G LRMIT
;
;
MSG D LINE^LR7OSUM4,LINE^LR7OSUM4
X X ;Need to see what is in X
G LRMIT
;
;
COMM D LN
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(37,CCNT,"TEST")_$$S^LR7OS(50,CCNT,"VALUE")_$$S^LR7OS(64,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
LR7OSUM6 ;VA/DALOI/dcm - Silent Patient cum cont. ;JUL 06, 2010 3:14 PM
+1 ;;5.2;LAB SERVICE;**121,201,187,286,356,372,1027**;NOV 01, 1997;Build 11
+2 ;
LRUDT(X) ;Get output date/time
+1 NEW LRTIM,I
+2 SET LRTIM=$EXTRACT(X,9,12)
FOR I=0:0
IF $LENGTH(LRTIM)=4
QUIT
SET LRTIM=LRTIM_0
+3 SET LRTIM=$SELECT(LRTIM?4"0":" ",1:$EXTRACT(LRTIM,1,2)_":"_$EXTRACT(LRTIM,3,4))
SET LRUDT=$$FMTE^XLFDT($PIECE(X,"."),"5Z")_" "_$JUSTIFY(LRTIM,5)_" "
+4 QUIT LRUDT
+5 ;
+6 ;
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 DO HEAD
QUIT
+1 QUIT
+2 ;
+3 ;
LRMISC SET LRFDT=0
SET LRPG=1
DO TOP
+1 ;
MHI SET LRMHN=$PIECE(^TMP($JOB,LRDFN,LRMH),U,1)
SET LRCNT=12
DO WR
+1 ;
MDT SET LRFDT=$ORDER(^TMP($JOB,LRDFN,"MISC",LRFDT))
IF LRFDT<1
GOTO END
+1 SET LRUDT=$$LRUDT(9999999-LRFDT)
DO LRCNT
SET LRMIT=0
+2 ;
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 ;S LRLO="",LRHI=","LRUNT=""
+4 SET LRLO=$PIECE(X,"^",6)
SET LRHI=$PIECE(X,"^",7)
SET LRUNT=$PIECE(X,"^",8)
+5 SET LRSPEM=$SELECT($LENGTH(LRSPE):$PIECE(^LAB(61,LRSPE,0),U,1),1:"")
+6 IF 'LRTEST
GOTO COMM
+7 SET LRNAME=$PIECE(^LAB(60,LRTEST,.1),U,1)
+8 ;S:$L(LRSPE)&($D(^LAB(60,LRTEST,1,LRSPE,0))) X=^(0),@("LRLO="_$S($L($P(X,U,2)):$P(X,U,2),1:"""""")),@("LRHI="_$S($L($P(X,U,3)):$P(X,U,3),1:"""""")),LRUNT=$P(X,U,7)
+9 ;
WR1 DO LINE^LR7OSUM4
+1 SET LRREF=$$EN^LRLRRVF(LRLO,LRHI)
+2 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,LRUDT)_$$S^LR7OS(19,CCNT,$EXTRACT(LRSPEM,1,16))_$$S^LR7OS(37,CCNT,LRNAME_":")_$$S^LR7OS(50,CCNT,LRVAL_" "_X1_" "_LRUNT)_$$S^LR7OS(67,CCNT,LRREF)
+3 IF '$PIECE($GET(^TMP("LRT",$JOB,LRNAME)),"^",2)
SET $PIECE(^(LRNAME),"^",2)=GCNT
+4 KILL LRREF
+5 GOTO LRMIT
+6 ;
+7 ;
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 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(37,CCNT,"TEST")_$$S^LR7OS(50,CCNT,"VALUE")_$$S^LR7OS(64,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
