source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRNUM.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1LRNUM ;SLC/BA-NUMERIC INPUT TRANSFORM ;2/6/91 08:55
2 ;;5.2;LAB SERVICE;**153,221**;Sep 27, 1994
3BEGIN Q:X="pending"
4 S LRLOW=$P(Q9,","),LRHIGH=$P(Q9,",",2),LRDEC=$P(Q9,",",3),Q8="" S:"<>"[$E(X,1) Q8=$E(X,1),X=$E(X,2,99) S Q1=$P(X,"."),Q2=$E($P(X,".",2),1,99) D CHECK
5END K LRLOW,LRHIGH,LRDEC,Q1,Q2,Q8,Q9
6 Q
7CHECK I $L(Q1),Q1'="-",Q1'="-0",+Q1'=Q1 K X Q
8 I $L(Q2),Q2'?1N.N K X Q
9 I $L(Q2)>LRDEC K X Q
10 I X>LRHIGH!(X<LRLOW)!($L($P(X,".",3)))!(X["..")!(X["-"&(+X=0)) K X Q
11 S X=Q8_X
12 Q
13COM ;expands lab description from LRMISTF1, dd
14 S LRMIN=$P(Q9,","),LRMAX=$P(Q9,",",2),LRSCN=$P(Q9,",",3) D COMCHK
15 K LRMIN,LRMAX,LRSCN,Q1,Q2,Q8,Q9
16 Q
17COMCHK I $L(X)>LRMAX!($L(X)<LRMIN)!(X'?.ANP) K X Q
18 N LRL,LRS,LRZ,LRY
19 S LRS="" D COMCHK1 Q:'$D(X) I '$D(LRNOECHO) N LRX S LRX=" ("_$E(LRS,1,$L(LRS)-1)_")" D EN^DDIOL(LRX) ; LRNOECHO SET IN LRVR4 TO PREVENT ECHO WHEN STUFFING COMMENTS.
20 S X=LRS
21 K LRMAX,LRMIN,LRSCN
22 Q
23COMCHK1 F I=1:1 Q:$P(X," ",I,99)="" S LRZ=$P(X," ",I),Y="" D:LRZ]"" SWITCH S LRL=$L(LRS)+$L(LRZ) S:LRL'>LRMAX LRS=LRS_LRZ_" " I LRL>LRMAX D K X Q
24 . N LRJ,LRX
25 . S LRX=" ... TOO LONG ... Expanded text is limited to "_LRMAX_" characters."
26 . F LRJ=$C(7),LRZ,LRX D EN^DDIOL(LRJ)
27 S LRS=$TR(LRS,";","-") ; Strip ";" - FileMan uses ";" to parse DR string.
28 Q
29SWITCH Q:$G(LRNOEXPD)
30 S LRY=0 F S LRY=$O(^LAB(62.5,"B",LRZ,LRY)) Q:LRY<1 I $L($P($G(^LAB(62.5,LRY,0)),U,4)),LRSCN[$P(^(0),U,4) S LRZ=$P(^LAB(62.5,LRY,0),U,2) Q:'$L($G(^(9))) S LRY=$P(X," ",I-1),LRY=$E(LRY,$L(LRY)) S:LRY>1 LRZ=^(9)
31 Q
32PN ;checks for positive or negative entry from LRMISTF1
33 I "PN"'[X!($L(X)'=1) K X W $C(7),!,"Enter 'N' for NEGATIVE or 'P' for POSITIVE" Q
34 W " (",$S(X="P":"POSITIVE",1:"NEGATIVE"),")"
35 Q
36AFS ;checks for acid fast stain entry from LRMISTF1
37 I '(X="DP"!(X="DN")!(X="CP")!(X="CN")) K X W $C(7),!,"Enter 'DP' for DIRECT POSITIVE, 'DN' for DIRECT NEGATIVE,",!,"'CP' for CONCENTRATE POSITIVE, or 'CN' for CONCENTRATE NEGATIVE" Q
38 W " (",$S(X="DP":"DIRECT POSITIVE",X="DN":"DIRECT NEGATIVE",X="CP":"CONCENTRATE POSITIVE",1:"CONCENTRATE NEGATIVE"),")"
39 Q
Note: See TracBrowser for help on using the repository browser.