- LAMIV10 ;SLC/DLG - PROCESS VITEK BACILLUS AND UID CARDS ;7/20/90 09:37 ;
- ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- ;0B Card; UID-1
- Q:$E(IN,1,2)'="00" Q:$E(IN,3,4)'="FF"
- F I1=1:1:10 S V=$E(IN,(I1+28),(I1+29)) S ORG(ISOL)=+^LAB(62.4,TSK,7,CARD,1,I1,0),V=$S(V="00":"1 TO 50K",V="01":">50K",1:""),ORG(ISOL)=ORG(ISOL)_"^"_V K:V="" ORG(ISOL) Q:ORG(ISOL)
- Q
- 510 ;12 CARD; UID-3
- Q:"123"'[$E(IN,2) Q:$E(IN,3,4)'="FF" S V=$E(IN,5,6),V=$S(V="FE":"1 TO 50K",V="FD":">50K",1:"")
- F I1=1:1:10 S X=$E(IN,(I1*2+7),(I1*2+8)),ORG(ISOL)=+^LAB(62.4,TSK,7,CARD,1,I1,0) D HEX S ORG(ISOL)=ORG(ISOL)_"^"_X K:X=0 ORG(ISOL) Q:ORG(ISOL)
- Q
- 52 S C=0,U="^" ;0C, 5.2, Bacillus card
- F I=3,7 S X1=$O(^LAB(62.4,TSK,7,CARD,1,"C",$E(IN,I,I+1),0)) D L2:X1>0 Q:$D(ORG)
- S RMK="",CODE=43,FL=$E(IN,44) D MSG
- Q
- L2 S ORG(ISOL)=+^LAB(62.4,TSK,7,CARD,1,X1,0),X=$E(IN,I+2,I+3) D PROB S ORG(ISOL,1)=X I X=""!(X<80) K ORG(ISOL) ;cancel if PROB<80%
- Q
- PROB D HEX I X>100 S X="" Q
- S:X=0 X="<1" S X=X_"% Probability" Q
- HEX S XX=X,X="" F II=1:1:$L(XX) S X=X*16+($F("0123456789ABCDEF",$E(XX,II))-2)
- Q
- MSG F X1=0:0 S X1=$O(^LAB(62.4,TSK,7,CARD,4,"B",CODE,X1)) Q:X1'>0 D MS2
- Q
- MS2 S X3=^LAB(62.4,TSK,7,CARD,4,X1,0)
- S X4=$P(X3,U,2) I $L(X4),X4'=FL Q ;
- S:$L(RMK) RMK=RMK_", " S RMK=RMK_$P(X3,U,3)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAMIV10 1294 printed Feb 18, 2025@23:09:38 Page 2
- LAMIV10 ;SLC/DLG - PROCESS VITEK BACILLUS AND UID CARDS ;7/20/90 09:37 ;
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- +2 ;0B Card; UID-1
- +3 if $EXTRACT(IN,1,2)'="00"
- QUIT
- if $EXTRACT(IN,3,4)'="FF"
- QUIT
- +4 FOR I1=1:1:10
- SET V=$EXTRACT(IN,(I1+28),(I1+29))
- SET ORG(ISOL)=+^LAB(62.4,TSK,7,CARD,1,I1,0)
- SET V=$SELECT(V="00":"1 TO 50K",V="01":">50K",1:"")
- SET ORG(ISOL)=ORG(ISOL)_"^"_V
- if V=""
- KILL ORG(ISOL)
- if ORG(ISOL)
- QUIT
- +5 QUIT
- 510 ;12 CARD; UID-3
- +1 if "123"'[$EXTRACT(IN,2)
- QUIT
- if $EXTRACT(IN,3,4)'="FF"
- QUIT
- SET V=$EXTRACT(IN,5,6)
- SET V=$SELECT(V="FE":"1 TO 50K",V="FD":">50K",1:"")
- +2 FOR I1=1:1:10
- SET X=$EXTRACT(IN,(I1*2+7),(I1*2+8))
- SET ORG(ISOL)=+^LAB(62.4,TSK,7,CARD,1,I1,0)
- DO HEX
- SET ORG(ISOL)=ORG(ISOL)_"^"_X
- if X=0
- KILL ORG(ISOL)
- if ORG(ISOL)
- QUIT
- +3 QUIT
- 52 ;0C, 5.2, Bacillus card
- SET C=0
- SET U="^"
- +1 FOR I=3,7
- SET X1=$ORDER(^LAB(62.4,TSK,7,CARD,1,"C",$EXTRACT(IN,I,I+1),0))
- if X1>0
- DO L2
- if $DATA(ORG)
- QUIT
- +2 SET RMK=""
- SET CODE=43
- SET FL=$EXTRACT(IN,44)
- DO MSG
- +3 QUIT
- L2 ;cancel if PROB<80%
- SET ORG(ISOL)=+^LAB(62.4,TSK,7,CARD,1,X1,0)
- SET X=$EXTRACT(IN,I+2,I+3)
- DO PROB
- SET ORG(ISOL,1)=X
- IF X=""!(X<80)
- KILL ORG(ISOL)
- +1 QUIT
- PROB DO HEX
- IF X>100
- SET X=""
- QUIT
- +1 if X=0
- SET X="<1"
- SET X=X_"% Probability"
- QUIT
- HEX SET XX=X
- SET X=""
- FOR II=1:1:$LENGTH(XX)
- SET X=X*16+($FIND("0123456789ABCDEF",$EXTRACT(XX,II))-2)
- +1 QUIT
- MSG FOR X1=0:0
- SET X1=$ORDER(^LAB(62.4,TSK,7,CARD,4,"B",CODE,X1))
- if X1'>0
- QUIT
- DO MS2
- +1 QUIT
- MS2 SET X3=^LAB(62.4,TSK,7,CARD,4,X1,0)
- +1 ;
- SET X4=$PIECE(X3,U,2)
- IF $LENGTH(X4)
- IF X4'=FL
- QUIT
- +2 if $LENGTH(RMK)
- SET RMK=RMK_", "
- SET RMK=RMK_$PIECE(X3,U,3)
- +3 QUIT