- LAMSA1 ;SLC/DLG - MICROSCAN PROCESS MIC/THERAPY RECORD ;3/7/91 09:47 ;
- ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- M ;Process the M record (LRM = 1 only 1 card type)
- S U="^",S=$S(LASPEC="Y":Y(9),1:Y(8)),X=$O(^LAB(62.4,TSK,7,LRM,2,"C",LADNA,0)) Q:X'>0 S LMDR=^LAB(62.4,TSK,7,LRM,2,X,0),LADN=$P(LMDR,U,2),STYLE=$P(^LAB(62.4,TSK,9),U,7)
- S S2=$P(^LAB(61.2,ORG(LAISO),0),U,3) G:S2="" A1 S S2=$S(S2="N":"GRAM NEG",S2="P":"GRAM POS",1:"")
- G:STYLE="F" A1 G AS4:LRSP="",AS:STYLE="I"
- A1 I $D(^LAB(62.06,"AI",LADN,LAMIC,"ANY","ANY"))#2 S S=^("ANY") G AS
- I $D(^LAB(62.06,"AI",LADN,LAMIC,"ANY",LRSP))#2 S S=^(LRSP) G AS
- I $D(^LAB(62.06,"AI",LADN,LAMIC,ORG(LAISO),"ANY"))#2 S S=^("ANY") G AS
- I $D(^LAB(62.06,"AI",LADN,LAMIC,ORG(LAISO),LRSP))#2 S S=^(LRSP) G AS
- G:S2="" A2
- I $D(^LAB(62.06,"AI",LADN,LAMIC,S2,LRSP))#2 S S=^(LRSP) G AS
- I $D(^LAB(62.06,"AI",LADN,LAMIC,S2,"ANY"))#2 S S=^("ANY") G AS
- A2 I $D(^LAB(62.06,"AI",LADN,LAMIC))#2 S S=^(LAMIC)
- AS I $D(^LAB(62.06,"AS",LADN,"ANY","ANY"))#2 S S=S_"^"_^("ANY") G AS1
- I $D(^LAB(62.06,"AS",LADN,"ANY",LRSP))#2 S S=S_"^"_^(LRSP) G AS1
- AS4 I $D(^LAB(62.06,"AS",LADN,ORG(LAISO),"ANY"))#2 S S=S_"^"_^("ANY") G AS1
- G:LRSP="" AS2 G:S2="" AS2
- I $D(^LAB(62.06,"AS",LADN,ORG(LAISO),LRSP))#2 S S=S_"^"_^(LRSP) G AS1
- I $D(^LAB(62.06,"AS",LADN,S2,"ANY"))#2 S S=S_"^"_^("ANY") G AS1
- AS3 I $D(^LAB(62.06,"AS",LADN,S2,LRSP))#2 S S=S_"^"_^(LRSP) G AS1
- AS2 I $D(^LAB(62.06,"AS",LADN))#2 S S=S_"^"_^(LADN)
- AS1 I $P(S,U,1)]"" S V=LAMIC_"^"_S X:$P(LMDR,U,3)]"" $P(LMDR,U,3) S ORG(LAISO,LADN)=V
- K S2,S,K,STYLE
- DGT ;Add the dosage guide text to Comment
- S X="For drug: "_Y(4)_" " F I=12,16,20,24 I Y(I)]"" S COMMO=COMMO+1,COMM(LAISO,1,COMMO)=X_Y(I)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAMSA1 1711 printed Mar 13, 2025@20:48:25 Page 2
- LAMSA1 ;SLC/DLG - MICROSCAN PROCESS MIC/THERAPY RECORD ;3/7/91 09:47 ;
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- M ;Process the M record (LRM = 1 only 1 card type)
- +1 SET U="^"
- SET S=$SELECT(LASPEC="Y":Y(9),1:Y(8))
- SET X=$ORDER(^LAB(62.4,TSK,7,LRM,2,"C",LADNA,0))
- if X'>0
- QUIT
- SET LMDR=^LAB(62.4,TSK,7,LRM,2,X,0)
- SET LADN=$PIECE(LMDR,U,2)
- SET STYLE=$PIECE(^LAB(62.4,TSK,9),U,7)
- +2 SET S2=$PIECE(^LAB(61.2,ORG(LAISO),0),U,3)
- if S2=""
- GOTO A1
- SET S2=$SELECT(S2="N":"GRAM NEG",S2="P":"GRAM POS",1:"")
- +3 if STYLE="F"
- GOTO A1
- if LRSP=""
- GOTO AS4
- if STYLE="I"
- GOTO AS
- A1 IF $DATA(^LAB(62.06,"AI",LADN,LAMIC,"ANY","ANY"))#2
- SET S=^("ANY")
- GOTO AS
- +1 IF $DATA(^LAB(62.06,"AI",LADN,LAMIC,"ANY",LRSP))#2
- SET S=^(LRSP)
- GOTO AS
- +2 IF $DATA(^LAB(62.06,"AI",LADN,LAMIC,ORG(LAISO),"ANY"))#2
- SET S=^("ANY")
- GOTO AS
- +3 IF $DATA(^LAB(62.06,"AI",LADN,LAMIC,ORG(LAISO),LRSP))#2
- SET S=^(LRSP)
- GOTO AS
- +4 if S2=""
- GOTO A2
- +5 IF $DATA(^LAB(62.06,"AI",LADN,LAMIC,S2,LRSP))#2
- SET S=^(LRSP)
- GOTO AS
- +6 IF $DATA(^LAB(62.06,"AI",LADN,LAMIC,S2,"ANY"))#2
- SET S=^("ANY")
- GOTO AS
- A2 IF $DATA(^LAB(62.06,"AI",LADN,LAMIC))#2
- SET S=^(LAMIC)
- AS IF $DATA(^LAB(62.06,"AS",LADN,"ANY","ANY"))#2
- SET S=S_"^"_^("ANY")
- GOTO AS1
- +1 IF $DATA(^LAB(62.06,"AS",LADN,"ANY",LRSP))#2
- SET S=S_"^"_^(LRSP)
- GOTO AS1
- AS4 IF $DATA(^LAB(62.06,"AS",LADN,ORG(LAISO),"ANY"))#2
- SET S=S_"^"_^("ANY")
- GOTO AS1
- +1 if LRSP=""
- GOTO AS2
- if S2=""
- GOTO AS2
- +2 IF $DATA(^LAB(62.06,"AS",LADN,ORG(LAISO),LRSP))#2
- SET S=S_"^"_^(LRSP)
- GOTO AS1
- +3 IF $DATA(^LAB(62.06,"AS",LADN,S2,"ANY"))#2
- SET S=S_"^"_^("ANY")
- GOTO AS1
- AS3 IF $DATA(^LAB(62.06,"AS",LADN,S2,LRSP))#2
- SET S=S_"^"_^(LRSP)
- GOTO AS1
- AS2 IF $DATA(^LAB(62.06,"AS",LADN))#2
- SET S=S_"^"_^(LADN)
- AS1 IF $PIECE(S,U,1)]""
- SET V=LAMIC_"^"_S
- if $PIECE(LMDR,U,3)]""
- XECUTE $PIECE(LMDR,U,3)
- SET ORG(LAISO,LADN)=V
- +1 KILL S2,S,K,STYLE
- DGT ;Add the dosage guide text to Comment
- +1 SET X="For drug: "_Y(4)_" "
- FOR I=12,16,20,24
- IF Y(I)]""
- SET COMMO=COMMO+1
- SET COMM(LAISO,1,COMMO)=X_Y(I)
- +2 QUIT
