LRMIXPD.m

LRMIXPD ; IHS/DIR/FJE - LAB DESCRIPTIONS 2/6/91 08:23 ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

EXPND ;expands lab description  from LRMISTF1

 I $L(X)>68!($L(X)<1)!(X'?.ANP) K X Q

 S %S="" D CHECK Q:'$D(X)  W "  (",$E(%S,1,$L(%S)-1),")" S X=%S

 K %L,%S,%Z

 Q

CHECK F I=1:1 Q:$P(X," ",I,99)=""  S %Z=$P(X," ",I),Y="" D:%Z]"" SWITCH S %L=$L(%S)+$L(%Z) S:%L'>68 %S=%S_%Z_" " I %L>68 W $C(7),!," ... TOO LONG ... Expanded text is limited to 68 characters." K X Q

 Q

SWITCH S Y=0 F  S Y=$O(^LAB(62.5,"B",%Z,Y)) Q:Y<1  I LRSCREEN[$P(^LAB(62.5,Y,0),U,4) S %Z=$P(^LAB(62.5,Y,0),U,2) Q:'$D(^(9))  S Y=$P(X," ",I-1),Y=$E(Y,$L(Y)) S:Y>1 %Z=^(9) Q

 Q

PN ;checks for positive or negative entry from LRMISTF1

 I "PN"'[X!($L(X)'=1) K X W $C(7),!,"Enter 'N' for NEGATIVE or 'P' for POSITIVE" Q

 W "  (",$S(X="P":"POSITIVE",1:"NEGATIVE"),")"

 Q

LRMIXPD   ; IHS/DIR/FJE - LAB DESCRIPTIONS 2/6/91 08:23 ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

EXPND     ;expands lab description  from LRMISTF1

 +1        IF $LENGTH(X)>68!($LENGTH(X)<1)!(X'?.ANP)

               KILL X

               QUIT 

 +2        SET %S=""

           DO CHECK

           IF '$DATA(X)

               QUIT 

           WRITE "  (",$EXTRACT(%S,1,$LENGTH(%S)-1),")"

           SET X=%S

 +3        KILL %L,%S,%Z

 +4        QUIT 

CHECK      FOR I=1:1

               IF $PIECE(X," ",I,99)=""

                   QUIT 

               SET %Z=$PIECE(X," ",I)

               SET Y=""

               IF %Z]""

                   DO SWITCH

               SET %L=$LENGTH(%S)+$LENGTH(%Z)

               IF %L'>68

                   SET %S=%S_%Z_" "

               IF %L>68

                   WRITE $CHAR(7),!," ... TOO LONG ... Expanded text is limited to 68 characters."

                   KILL X

                   QUIT 

 +1        QUIT 

SWITCH     SET Y=0

           FOR 

               SET Y=$ORDER(^LAB(62.5,"B",%Z,Y))

               IF Y<1

                   QUIT 

               IF LRSCREEN[$PIECE(^LAB(62.5,Y,0),U,4)

                   SET %Z=$PIECE(^LAB(62.5,Y,0),U,2)

                   IF '$DATA(^(9))

                       QUIT 

                   SET Y=$PIECE(X," ",I-1)

                   SET Y=$EXTRACT(Y,$LENGTH(Y))

                   IF Y>1

                       SET %Z=^(9)

                   QUIT 

 +1        QUIT 

PN        ;checks for positive or negative entry from LRMISTF1

 +1        IF "PN"'[X!($LENGTH(X)'=1)

               KILL X

               WRITE $CHAR(7),!,"Enter 'N' for NEGATIVE or 'P' for POSITIVE"

               QUIT 

 +2        WRITE "  (",$SELECT(X="P":"POSITIVE",1:"NEGATIVE"),")"

 +3        QUIT