LR7OSUM6.m

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