LRMIXPD ;SLC/BA - LAB DESCRIPTIONS ;2/6/91 08:23 ;
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIXPD 832 printed Dec 13, 2024@02:17:50 Page 2
LRMIXPD ;SLC/BA - LAB DESCRIPTIONS ;2/6/91 08:23 ;
+1 ;;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
