BLRLRRP1.m

BLRLRRP1 ;IHS/MSC/MKK - INTERIM REPORTS IHS Utilities ; 22-Oct-2013 09:22 ; MKK

 ;;5.2;LAB SERVICE;**1033**;NOV 01, 1997

 ;

EEP ; Ersatz EP

 D EEP^BLRGMENU

 Q

 ;

 ;from LRRP1,LRRP2

 ;

LRREFS ; EP - Reference Range

 I $L(LRREFS)<16 D

 . W ?43,$E(LRREFS,1,15),?55,$S(LRTHER:"(TR)",1:"")

 . W ?55,$S(LRTHER:"(TR)",1:"")

 . I LRPLS'="" W ?59,$J("["_LRPLS_"]",6)

 . W ?66,$$GETCOMPD^BLRUTIL4

 I $L(LRREFS)>15 D REFWRAP^BLRLRRP1

 K LRREFS

 Q

 ;

REFWRAP ; EP - Have to "wrap" the Reference Range string

 NEW LINE,LM,MAX,TAB

 ;

 S TAB=43,MAX=15

 ;

 ; Use FileMan DIWP routine to "wrap" string, if necessary.

 S X=LRREFS

 K ^UTILITY($J,"W")

 S LM=2

  S DIWL=LM,DIWR="",DIWF="C"_MAX

 D ^DIWP

 ;

 ; Use loop to output result without extra line feed

 S LINE=0

 F  S LINE=$O(^UTILITY($J,"W",LM,LINE))  Q:LINE<1  D

 . W:LINE=1 ?TAB

 . W:LINE>1 !,?TAB

 . W $$TRIM^XLFSTR($G(^UTILITY($J,"W",LM,LINE,0)),"L",$C(9))

 . I LINE=1 D

 .. W ?55,$S(LRTHER:"(TR)",1:"")

 .. I LRPLS'="" W ?59,$J("["_LRPLS_"]",6)

 .. W ?66,$$GETCOMPD^BLRUTIL4

 K ^UTILITY($J,"W")

 Q

 ;

CONDSPEC() ; EP - Specimen Condition

 S SPMCOND=$P($G(^LR(+LRDFN,"CH",+LRIDT,"IHS")),"^")

 W:$L(SPMCOND) !,?46,"Specimen Condition:",SPMCOND

 Q

BLRLRRP1  ;IHS/MSC/MKK - INTERIM REPORTS IHS Utilities ; 22-Oct-2013 09:22 ; MKK

 +1       ;;5.2;LAB SERVICE;**1033**;NOV 01, 1997

 +2       ;

EEP       ; Ersatz EP

 +1        DO EEP^BLRGMENU

 +2        QUIT 

 +3       ;

 +4       ;from LRRP1,LRRP2

 +5       ;

LRREFS    ; EP - Reference Range

 +1        IF $LENGTH(LRREFS)<16

               Begin DoDot:1

 +2                WRITE ?43,$EXTRACT(LRREFS,1,15),?55,$SELECT(LRTHER:"(TR)",1:"")

 +3                WRITE ?55,$SELECT(LRTHER:"(TR)",1:"")

 +4                IF LRPLS'=""

                       WRITE ?59,$JUSTIFY("["_LRPLS_"]",6)

 +5                WRITE ?66,$$GETCOMPD^BLRUTIL4

               End DoDot:1

 +6        IF $LENGTH(LRREFS)>15

               DO REFWRAP^BLRLRRP1

 +7        KILL LRREFS

 +8        QUIT 

 +9       ;

REFWRAP   ; EP - Have to "wrap" the Reference Range string

 +1        NEW LINE,LM,MAX,TAB

 +2       ;

 +3        SET TAB=43

           SET MAX=15

 +4       ;

 +5       ; Use FileMan DIWP routine to "wrap" string, if necessary.

 +6        SET X=LRREFS

 +7        KILL ^UTILITY($JOB,"W")

 +8        SET LM=2

 +9        SET DIWL=LM

           SET DIWR=""

           SET DIWF="C"_MAX

 +10       DO ^DIWP

 +11      ;

 +12      ; Use loop to output result without extra line feed

 +13       SET LINE=0

 +14       FOR 

               SET LINE=$ORDER(^UTILITY($JOB,"W",LM,LINE))

               IF LINE<1

                   QUIT 

               Begin DoDot:1

 +15               IF LINE=1

                       WRITE ?TAB

 +16               IF LINE>1

                       WRITE !,?TAB

 +17               WRITE $$TRIM^XLFSTR($GET(^UTILITY($JOB,"W",LM,LINE,0)),"L",$CHAR(9))

 +18               IF LINE=1

                       Begin DoDot:2

 +19                       WRITE ?55,$SELECT(LRTHER:"(TR)",1:"")

 +20                       IF LRPLS'=""

                               WRITE ?59,$JUSTIFY("["_LRPLS_"]",6)

 +21                       WRITE ?66,$$GETCOMPD^BLRUTIL4

                       End DoDot:2

               End DoDot:1

 +22       KILL ^UTILITY($JOB,"W")

 +23       QUIT 

 +24      ;

CONDSPEC() ; EP - Specimen Condition

 +1        SET SPMCOND=$PIECE($GET(^LR(+LRDFN,"CH",+LRIDT,"IHS")),"^")

 +2        IF $LENGTH(SPMCOND)

               WRITE !,?46,"Specimen Condition:",SPMCOND

 +3        QUIT