BLRALBM1 ;DAOU/ALA-Build Micro Results for Bacteria [ 11/18/2002 1:33 PM ]
;;5.2;LR;**1013,1015**;NOV 18, 2002
;
;
ANTI ;EP
I $P($G(^LR(LRDFN,"MI",LRIDT,14,0)),U,4)>0 D
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=$E(BLRABLKS,1,28)_"Antibiotic Level(s):"
. S BLRAZ="ANTIBIOTIC",BLRAZ1=20 D Z1
. S BLRAZ=BLRAZ_"CONC RANGE (ug/ml)",BLRAZ1=42 D Z1
. S BLRAZ=BLRAZ_"DRAW TIME"
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
. S B=0 F S B=$O(^LR(LRDFN,"MI",LRIDT,14,B)) Q:B<1 D
.. S BLRALAL=$G(^LR(LRDFN,"MI",LRIDT,14,B,0))
.. S BLRAZ=$P(BLRALAL,U),BLRAZ1=20 D Z1
.. S BLRAZ=BLRAZ_$P(BLRALAL,U,3),BLRAZ1=42 D Z1
.. S BLRAZ=BLRAZ_$S($P(BLRALAL,U,2)="P":"PEAK",$P(BLRALAL,U,2)="T":"TROUGH",1:"")
.. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
Q
BACT ;EP
I '$L($P($G(^LR(LRDFN,"MI",LRIDT,1)),U)) Q:'$D(LRWRDVEW) Q:LRSB'=1
D BUG
I $D(^LR(LRDFN,"MI",LRIDT,2,0)) D GRAM
I $D(^LR(LRDFN,"MI",LRIDT,25,0)) D BSMEAR
I $D(^LR(LRDFN,"MI",LRIDT,3,0)) D BRMK,BACT^BLRALBM4
I $D(^LR(LRDFN,"MI",LRIDT,4,0)),$P($G(^(0)),U,4)>0 D
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)="Bacteriology Remark(s):"
. S B=0 F S B=+$O(^LR(LRDFN,"MI",LRIDT,4,B)) Q:B<1 D
.. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=" "_$G(^LR(LRDFN,"MI",LRIDT,4,B,0))
Q
;
BUG S BLRABUG=$G(^LR(LRDFN,"MI",LRIDT,1))
S LRTUS=$P(BLRABUG,U,2),DZ=$P(BLRABUG,U,3),LRUS=$P(BLRABUG,U,6)
S LRNS=$P(BLRABUG,U,5),Y=$P(BLRABUG,U) D D^LRU
S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)="* BACTERIOLOGY "_$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ ;IHS/ANMC/CLS 08/18/96
S LRPRE=19 D PRE
I $L(LRUS) S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)="URINE SCREEN: "_$S(LRUS="N":"Negative",LRUS="P":"Positive",1:LRUS)
I $L(LRNS) S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)="SPUTUM SCREEN: "_LRNS
Q
;
GRAM S BLRAZ="GRAM STAIN:",BLRAZ1=14 D Z1
S LRGRM=0 F S LRGRM=+$O(^LR(LRDFN,"MI",LRIDT,2,LRGRM)) Q:LRGRM<1 D
. S BLRAZ=BLRAZ_$G(^LR(LRDFN,"MI",LRIDT,2,LRGRM,0))
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
. S BLRAZ=$E(BLRABLKS,1,14)
Q
;
BSMEAR S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)="BACTERIOLOGY SMEAR/PREP:"
S LRMYC=0 F S LRMYC=+$O(^LR(LRDFN,"MI",LRIDT,25,LRMYC)) Q:LRMYC<1 D
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=$E(BLRABLKS,1,5)_$G(^LR(LRDFN,"MI",LRIDT,25,LRMYC,0))
Q
;
BRMK S (LRBUG,LR2ORMOR)=0
F LRAX=1,2 S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 S:LRAX=2 LR2ORMOR=1
I LRAX'=1 S (LRBUG,LRTSTS)=0 F LRAX=1:1 S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 D LST
Q
;
LST S (LRBUG(LRAX),LRORG)=$P($G(^LR(LRDFN,"MI",LRIDT,3,LRBUG,0)),U)
S BLRAORG=$G(^LR(LRDFN,"MI",LRIDT,3,LRBUG,0))
S LRQU=$P(BLRAORG,U,2),LRSSD=$P(BLRAORG,U,3,8)
S LRORG=$P($G(^LAB(61.2,LRORG,0)),U)
I LRSSD'?.U D
. S LRSIC1=$P(LRSSD,U),LRSBC1=$P(LRSSD,U,2),LRDRTM1=$P(LRSSD,U,3)
. S LRSIC2=$P(LRSSD,U,4),LRSBC2=$P(LRSSD,U,5),LRDRTM2=$P(LRSSD,U,6),LRSSD=1
S BLRAZ=$E(BLRABLKS,1,17)
I LRAX=1 D LIN S BLRAZ="CULTURE RESULTS:",BLRAZ1=17 D Z1
S BLRAZ=BLRAZ_$S(LR2ORMOR:LRBUG_", ",1:"")_LRQU_LRORG
S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
I LRSSD D SSD
S:$D(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2)) LRTSTS=LRTSTS+1 I $D(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,0)),$P($G(^(0)),U,4)>0 D MIC
I $D(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,0)),$P($G(^(0)),U,4)>0 D CMNT
Q
;
SSD S LRDRTM1=$S(LRDRTM1="P":"PEAK",LRDRTM1="T":"TROUGH",1:LRDRTM1),LRDRTM2=$S(LRDRTM2="P":"PEAK",LRDRTM2="T":"TROUGH",1:LRDRTM2)
S BLRAZ=$E(BLRABLKS,1,20)
I $L(LRSIC1) S BLRAZ=BLRAZ_"SIT " S:$L(LRDRTM1) BLRAZ=BLRAZ_"("_LRDRTM1_"): "_LRSIC1
I $L(LRSBC1) S BLRAZ=BLRAZ_"SBT " S:$L(LRDRTM1) BLRAZ=BLRAZ_"("_LRDRTM1_"): "_LRSBC1
I $L(LRSIC2) S BLRAZ=BLRAZ_"SIT " S:$L(LRDRTM2) BLRAZ=BLRAZ_"("_LRDRTM2_"): "_LRSIC2
I $L(LRSBC2) S BLRAZ=BLRAZ_"SBT " S:$L(LRDRTM2) BLRAZ=BLRAZ_"("_LRDRTM2_"): "_LRSBC2
Q
;
MIC S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=$E(BLRABLKS,1,18)="Antibiotic"
S B=0 F S B=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1 D
. I $L($P($G(^(B,0)),U,2,3))>0 D
.. S BLRAZ=$G(^TMP($J,"BLRA",BLRADSP,0)),BLRAZ1=35 D Z1
.. S BLRAZ=BLRAZ_"MIC (ug/ml)",BLRAZ1=50 D Z1
.. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ_"MBC (ug/ml)"
S B=0 F S B=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1 D
. S BLRAMIC=$G(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B,0))
. S BLRAZ=$E(BLRABLKS,1,18)_$P(BLRAMIC,U),BLRAZ1=35 D Z1
. S BLRAZ=BLRAZ_$J($P(BLRAMIC,U,2),7),BLRAZ1=50 D Z1
. S BLRAZ=BLRAZ_$J($P(BLRAMIC,U,3),7)
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
Q
;
CMNT S LRPC=0
F A=0:1 S LRPC=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC)) Q:LRPC<1 D
. I A=0 D Q
.. S BLRAZ="Comment: ",BLRAZ1=20 D Z1
.. S BLRAZ=BLRAZ_$G(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC,0))
.. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=$E(BLRABLKS,1,20)_BLRAZ
. S BLRAZ=$G(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC,0))
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=$E(BLRABLKS,1,29)_BLRAZ
Q
;
PRE ;EP
Q:LRTUS["F"&('$D(^XUSEC("LRLAB",DUZ))!$D(LRWRDVEW))
I +$O(^LR(LRDFN,"MI",LRIDT,LRPRE,0)) D
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)="Preliminary Comments: "
. S J=0 F S J=+$O(^LR(LRDFN,"MI",LRIDT,LRPRE,J)) Q:J<1 D
.. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=$E(BLRABLKS,1,3)_$G(^LR(LRDFN,"MI",LRIDT,LRPRE,J,0))
D LIN
Q
;
Z1 ; Pad with trailing spaces
F BLRAI=1:1:(BLRAZ1-$L(BLRAZ)) S BLRAZ=BLRAZ_" "
Q
;
LIN ;EP
; Set a Blank Line
S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=" "
Q
BLRALBM1 ;DAOU/ALA-Build Micro Results for Bacteria [ 11/18/2002 1:33 PM ]
+1 ;;5.2;LR;**1013,1015**;NOV 18, 2002
+2 ;
+3 ;
ANTI ;EP
+1 IF $PIECE($GET(^LR(LRDFN,"MI",LRIDT,14,0)),U,4)>0
Begin DoDot:1
+2 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=$EXTRACT(BLRABLKS,1,28)_"Antibiotic Level(s):"
+3 SET BLRAZ="ANTIBIOTIC"
SET BLRAZ1=20
DO Z1
+4 SET BLRAZ=BLRAZ_"CONC RANGE (ug/ml)"
SET BLRAZ1=42
DO Z1
+5 SET BLRAZ=BLRAZ_"DRAW TIME"
+6 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
+7 SET B=0
FOR
SET B=$ORDER(^LR(LRDFN,"MI",LRIDT,14,B))
IF B<1
QUIT
Begin DoDot:2
+8 SET BLRALAL=$GET(^LR(LRDFN,"MI",LRIDT,14,B,0))
+9 SET BLRAZ=$PIECE(BLRALAL,U)
SET BLRAZ1=20
DO Z1
+10 SET BLRAZ=BLRAZ_$PIECE(BLRALAL,U,3)
SET BLRAZ1=42
DO Z1
+11 SET BLRAZ=BLRAZ_$SELECT($PIECE(BLRALAL,U,2)="P":"PEAK",$PIECE(BLRALAL,U,2)="T":"TROUGH",1:"")
+12 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
End DoDot:2
End DoDot:1
+13 QUIT
BACT ;EP
+1 IF '$LENGTH($PIECE($GET(^LR(LRDFN,"MI",LRIDT,1)),U))
IF '$DATA(LRWRDVEW)
QUIT
IF LRSB'=1
QUIT
+2 DO BUG
+3 IF $DATA(^LR(LRDFN,"MI",LRIDT,2,0))
DO GRAM
+4 IF $DATA(^LR(LRDFN,"MI",LRIDT,25,0))
DO BSMEAR
+5 IF $DATA(^LR(LRDFN,"MI",LRIDT,3,0))
DO BRMK
DO BACT^BLRALBM4
+6 IF $DATA(^LR(LRDFN,"MI",LRIDT,4,0))
IF $PIECE($GET(^(0)),U,4)>0
Begin DoDot:1
+7 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)="Bacteriology Remark(s):"
+8 SET B=0
FOR
SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,4,B))
IF B<1
QUIT
Begin DoDot:2
+9 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=" "_$GET(^LR(LRDFN,"MI",LRIDT,4,B,0))
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
BUG SET BLRABUG=$GET(^LR(LRDFN,"MI",LRIDT,1))
+1 SET LRTUS=$PIECE(BLRABUG,U,2)
SET DZ=$PIECE(BLRABUG,U,3)
SET LRUS=$PIECE(BLRABUG,U,6)
+2 SET LRNS=$PIECE(BLRABUG,U,5)
SET Y=$PIECE(BLRABUG,U)
DO D^LRU
+3 ;IHS/ANMC/CLS 08/18/96
SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)="* BACTERIOLOGY "_$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ
+4 SET LRPRE=19
DO PRE
+5 IF $LENGTH(LRUS)
SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)="URINE SCREEN: "_$SELECT(LRUS="N":"Negative",LRUS="P":"Positive",1:LRUS)
+6 IF $LENGTH(LRNS)
SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)="SPUTUM SCREEN: "_LRNS
+7 QUIT
+8 ;
GRAM SET BLRAZ="GRAM STAIN:"
SET BLRAZ1=14
DO Z1
+1 SET LRGRM=0
FOR
SET LRGRM=+$ORDER(^LR(LRDFN,"MI",LRIDT,2,LRGRM))
IF LRGRM<1
QUIT
Begin DoDot:1
+2 SET BLRAZ=BLRAZ_$GET(^LR(LRDFN,"MI",LRIDT,2,LRGRM,0))
+3 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
+4 SET BLRAZ=$EXTRACT(BLRABLKS,1,14)
End DoDot:1
+5 QUIT
+6 ;
BSMEAR SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)="BACTERIOLOGY SMEAR/PREP:"
+1 SET LRMYC=0
FOR
SET LRMYC=+$ORDER(^LR(LRDFN,"MI",LRIDT,25,LRMYC))
IF LRMYC<1
QUIT
Begin DoDot:1
+2 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=$EXTRACT(BLRABLKS,1,5)_$GET(^LR(LRDFN,"MI",LRIDT,25,LRMYC,0))
End DoDot:1
+3 QUIT
+4 ;
BRMK SET (LRBUG,LR2ORMOR)=0
+1 FOR LRAX=1,2
SET LRBUG=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG))
IF LRBUG<1
QUIT
IF LRAX=2
SET LR2ORMOR=1
+2 IF LRAX'=1
SET (LRBUG,LRTSTS)=0
FOR LRAX=1:1
SET LRBUG=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG))
IF LRBUG<1
QUIT
DO LST
+3 QUIT
+4 ;
LST SET (LRBUG(LRAX),LRORG)=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,3,LRBUG,0)),U)
+1 SET BLRAORG=$GET(^LR(LRDFN,"MI",LRIDT,3,LRBUG,0))
+2 SET LRQU=$PIECE(BLRAORG,U,2)
SET LRSSD=$PIECE(BLRAORG,U,3,8)
+3 SET LRORG=$PIECE($GET(^LAB(61.2,LRORG,0)),U)
+4 IF LRSSD'?.U
Begin DoDot:1
+5 SET LRSIC1=$PIECE(LRSSD,U)
SET LRSBC1=$PIECE(LRSSD,U,2)
SET LRDRTM1=$PIECE(LRSSD,U,3)
+6 SET LRSIC2=$PIECE(LRSSD,U,4)
SET LRSBC2=$PIECE(LRSSD,U,5)
SET LRDRTM2=$PIECE(LRSSD,U,6)
SET LRSSD=1
End DoDot:1
+7 SET BLRAZ=$EXTRACT(BLRABLKS,1,17)
+8 IF LRAX=1
DO LIN
SET BLRAZ="CULTURE RESULTS:"
SET BLRAZ1=17
DO Z1
+9 SET BLRAZ=BLRAZ_$SELECT(LR2ORMOR:LRBUG_", ",1:"")_LRQU_LRORG
+10 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
+11 IF LRSSD
DO SSD
+12 IF $DATA(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2))
SET LRTSTS=LRTSTS+1
IF $DATA(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,0))
IF $PIECE($GET(^(0)),U,4)>0
DO MIC
+13 IF $DATA(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,0))
IF $PIECE($GET(^(0)),U,4)>0
DO CMNT
+14 QUIT
+15 ;
SSD SET LRDRTM1=$SELECT(LRDRTM1="P":"PEAK",LRDRTM1="T":"TROUGH",1:LRDRTM1)
SET LRDRTM2=$SELECT(LRDRTM2="P":"PEAK",LRDRTM2="T":"TROUGH",1:LRDRTM2)
+1 SET BLRAZ=$EXTRACT(BLRABLKS,1,20)
+2 IF $LENGTH(LRSIC1)
SET BLRAZ=BLRAZ_"SIT "
IF $LENGTH(LRDRTM1)
SET BLRAZ=BLRAZ_"("_LRDRTM1_"): "_LRSIC1
+3 IF $LENGTH(LRSBC1)
SET BLRAZ=BLRAZ_"SBT "
IF $LENGTH(LRDRTM1)
SET BLRAZ=BLRAZ_"("_LRDRTM1_"): "_LRSBC1
+4 IF $LENGTH(LRSIC2)
SET BLRAZ=BLRAZ_"SIT "
IF $LENGTH(LRDRTM2)
SET BLRAZ=BLRAZ_"("_LRDRTM2_"): "_LRSIC2
+5 IF $LENGTH(LRSBC2)
SET BLRAZ=BLRAZ_"SBT "
IF $LENGTH(LRDRTM2)
SET BLRAZ=BLRAZ_"("_LRDRTM2_"): "_LRSBC2
+6 QUIT
+7 ;
MIC SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=$EXTRACT(BLRABLKS,1,18)="Antibiotic"
+1 SET B=0
FOR
SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B))
IF B<1
QUIT
Begin DoDot:1
+2 IF $LENGTH($PIECE($GET(^(B,0)),U,2,3))>0
Begin DoDot:2
+3 SET BLRAZ=$GET(^TMP($JOB,"BLRA",BLRADSP,0))
SET BLRAZ1=35
DO Z1
+4 SET BLRAZ=BLRAZ_"MIC (ug/ml)"
SET BLRAZ1=50
DO Z1
+5 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ_"MBC (ug/ml)"
End DoDot:2
End DoDot:1
+6 SET B=0
FOR
SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B))
IF B<1
QUIT
Begin DoDot:1
+7 SET BLRAMIC=$GET(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B,0))
+8 SET BLRAZ=$EXTRACT(BLRABLKS,1,18)_$PIECE(BLRAMIC,U)
SET BLRAZ1=35
DO Z1
+9 SET BLRAZ=BLRAZ_$JUSTIFY($PIECE(BLRAMIC,U,2),7)
SET BLRAZ1=50
DO Z1
+10 SET BLRAZ=BLRAZ_$JUSTIFY($PIECE(BLRAMIC,U,3),7)
+11 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
End DoDot:1
+12 QUIT
+13 ;
CMNT SET LRPC=0
+1 FOR A=0:1
SET LRPC=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC))
IF LRPC<1
QUIT
Begin DoDot:1
+2 IF A=0
Begin DoDot:2
+3 SET BLRAZ="Comment: "
SET BLRAZ1=20
DO Z1
+4 SET BLRAZ=BLRAZ_$GET(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC,0))
+5 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=$EXTRACT(BLRABLKS,1,20)_BLRAZ
End DoDot:2
QUIT
+6 SET BLRAZ=$GET(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC,0))
+7 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=$EXTRACT(BLRABLKS,1,29)_BLRAZ
End DoDot:1
+8 QUIT
+9 ;
PRE ;EP
+1 IF LRTUS["F"&('$DATA(^XUSEC("LRLAB",DUZ))!$DATA(LRWRDVEW))
QUIT
+2 IF +$ORDER(^LR(LRDFN,"MI",LRIDT,LRPRE,0))
Begin DoDot:1
+3 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)="Preliminary Comments: "
+4 SET J=0
FOR
SET J=+$ORDER(^LR(LRDFN,"MI",LRIDT,LRPRE,J))
IF J<1
QUIT
Begin DoDot:2
+5 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=$EXTRACT(BLRABLKS,1,3)_$GET(^LR(LRDFN,"MI",LRIDT,LRPRE,J,0))
End DoDot:2
End DoDot:1
+6 DO LIN
+7 QUIT
+8 ;
Z1 ; Pad with trailing spaces
+1 FOR BLRAI=1:1:(BLRAZ1-$LENGTH(BLRAZ))
SET BLRAZ=BLRAZ_" "
+2 QUIT
+3 ;
LIN ;EP
+1 ; Set a Blank Line
+2 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=" "
+3 QUIT
