- LROR4A ;AVAMC/REG/SLC/CJS/BA - MICRO PATIENT REPORT - BACTERIA, SIC/SBC, MIC ; 3/16/88 2:41 PM ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- ANTI ;from LRMIPSZ1
- I $P(^LR(LRDFN,"MI",LRIDT,14,0),U,4)>0 W !!,?28,"Antibiotic Level(s):",!,"ANTIBIOTIC",?20,"CONC RANGE (ug/ml)",?42,"DRAW TIME"
- I S B=0 F I=0:0 S B=$O(^LR(LRDFN,"MI",LRIDT,14,B)) Q:B<1 W !,$P(^LR(LRDFN,"MI",LRIDT,14,B,0),U),?20,$P(^(0),U,3),?42,$S($P(^(0),U,2)="P":"PEAK",$P(^(0),U,2)="T":"TROUGH",1:"")
- Q
- BACT ;from LRMIPSZ1
- I '$L($P(^LR(LRDFN,"MI",LRIDT,1),U)) Q:'$D(LRWRDVEW) Q:LRSB'=1
- D BUG
- I $D(^LR(LRDFN,"MI",LRIDT,2,0)) D FH^LROR4 Q:LREND D GRAM
- I $D(^LR(LRDFN,"MI",LRIDT,25,0)) D FH^LROR4 Q:LREND D BSMEAR
- I $D(^LR(LRDFN,"MI",LRIDT,3,0)) D FH^LROR4 Q:LREND D BRMK Q:LREND D BACT^LROR4B Q:LREND
- I $D(^LR(LRDFN,"MI",LRIDT,4,0)),$P(^(0),U,4)>0 D FH^LROR4 Q:LREND W:LRHC ! W !,"Bacteriology Remark(s):" S B=0 F I=0:0 S B=+$O(^LR(LRDFN,"MI",LRIDT,4,B)) Q:B<1 W !,?3,^LR(LRDFN,"MI",LRIDT,4,B,0)
- Q
- BUG S LRTUS=$P(^LR(LRDFN,"MI",LRIDT,1),U,2),DZ=$P(^(1),U,3),LRUS=$P(^(1),U,6),LRNS=$P(^(1),U,5),Y=$P(^(1),U) D D^LRU
- D:$Y>(IOSL-LRFLIP) WAIT^LROR4 Q:LREND
- W:LRHC ! W !,"* BACTERIOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_" TECH CODE: "_DZ
- S LRPRE=19 D PRE^LRMIPSU
- I $L(LRUS) W !,"URINE SCREEN: "_$S(LRUS="N":"Negative",LRUS="P":"Positive",1:LRUS) W:LRHC !
- I $L(LRNS) W !,"SPUTUM SCREEN: ",LRNS W:LRHC !
- Q
- GRAM W !,"GRAM STAIN:" S LRGRM=0 F I=0:0 S LRGRM=+$O(^LR(LRDFN,"MI",LRIDT,2,LRGRM)) Q:LRGRM<1 W ?14,^(LRGRM,0),!
- W:LRHC !
- Q
- BSMEAR W !,"BACTERIOLOGY SMEAR/PREP:",! S LRMYC=0 F I=0:0 S LRMYC=+$O(^LR(LRDFN,"MI",LRIDT,25,LRMYC)) Q:LRMYC<1 W ?5,^(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(^LR(LRDFN,"MI",LRIDT,3,LRBUG,0),U),LRQU=$P(^(0),U,2),LRSSD=$P(^(0),U,3,8),LRORG=$P(^LAB(61.2,LRORG,0),U)
- I LRSSD'?."^" S LRSIC1=$P(LRSSD,U),LRSBC1=$P(LRSSD,U,2),LRDRTM1=$P(LRSSD,U,3),LRSIC2=$P(LRSSD,U,4),LRSBC2=$P(LRSSD,U,5),LRDRTM2=$P(LRSSD,U,6),LRSSD=1
- W:LRHC ! W:LRAX=1 !,"CULTURE RESULTS:" W:LRAX>1 ! W ?17,$S(LR2ORMOR:LRBUG_". ",1:""),LRQU,LRORG
- I LRSSD D FH^LROR4 Q:LREND D SSD W:LRHC !
- S:$D(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2)) LRTSTS=LRTSTS+1 I $D(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,0)),$P(^(0),U,4)>0 D MIC
- I $D(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,0)),$P(^(0),U,4)>0 D CMNT
- Q
- SSD W ! S LRDRTM1=$S(LRDRTM1="P":"PEAK",LRDRTM1="T":"TROUGH",1:LRDRTM1),LRDRTM2=$S(LRDRTM2="P":"PEAK",LRDRTM2="T":"TROUGH",1:LRDRTM2)
- I $L(LRSIC1) W !,?20,"SIT " W:$L(LRDRTM1) "(",LRDRTM1,")" W ": ",LRSIC1
- I $L(LRSBC1) W !,?20,"SBT " W:$L(LRDRTM1) "(",LRDRTM1,")" W ": ",LRSBC1
- I $L(LRSIC2) W !,?20,"SIT " W:$L(LRDRTM2) "(",LRDRTM2,")" W ": ",LRSIC2
- I $L(LRSBC2) W !,?20,"SBT " W:$L(LRDRTM2) "(",LRDRTM2,")" W ": ",LRSBC2
- Q
- MIC W !,?18,"Antibiotic" S B=0 F I=0:0 S B=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1 I $L($P(^(B,0),U,2,3))>1 W ?35,"MIC (ug/ml)",?50,"MBC (ug/ml)"
- S B=0 F I=0:0 S B=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1 W !,?18,$P(^(B,0),U),?35,$J($P(^(0),U,2),7),?50,$S($P(^(0),U,3):$J($P(^(0),U,3),7),1:"")
- Q
- CMNT S LRPC=0 F A=0:1 S LRPC=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC)) Q:LRPC<1 W !?20 W:A=0 "Comment: " W ?29,^(LRPC,0)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLROR4A 3408 printed Feb 18, 2025@23:44:33 Page 2
- LROR4A ;AVAMC/REG/SLC/CJS/BA - MICRO PATIENT REPORT - BACTERIA, SIC/SBC, MIC ; 3/16/88 2:41 PM ;
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- ANTI ;from LRMIPSZ1
- +1 IF $PIECE(^LR(LRDFN,"MI",LRIDT,14,0),U,4)>0
- WRITE !!,?28,"Antibiotic Level(s):",!,"ANTIBIOTIC",?20,"CONC RANGE (ug/ml)",?42,"DRAW TIME"
- +2 IF $TEST
- SET B=0
- FOR I=0:0
- SET B=$ORDER(^LR(LRDFN,"MI",LRIDT,14,B))
- if B<1
- QUIT
- WRITE !,$PIECE(^LR(LRDFN,"MI",LRIDT,14,B,0),U),?20,$PIECE(^(0),U,3),?42,$SELECT($PIECE(^(0),U,2)="P":"PEAK",$PIECE(^(0),U,2)="T":"TROUGH",1:"")
- +3 QUIT
- BACT ;from LRMIPSZ1
- +1 IF '$LENGTH($PIECE(^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 FH^LROR4
- if LREND
- QUIT
- DO GRAM
- +4 IF $DATA(^LR(LRDFN,"MI",LRIDT,25,0))
- DO FH^LROR4
- if LREND
- QUIT
- DO BSMEAR
- +5 IF $DATA(^LR(LRDFN,"MI",LRIDT,3,0))
- DO FH^LROR4
- if LREND
- QUIT
- DO BRMK
- if LREND
- QUIT
- DO BACT^LROR4B
- if LREND
- QUIT
- +6 IF $DATA(^LR(LRDFN,"MI",LRIDT,4,0))
- IF $PIECE(^(0),U,4)>0
- DO FH^LROR4
- if LREND
- QUIT
- if LRHC
- WRITE !
- WRITE !,"Bacteriology Remark(s):"
- SET B=0
- FOR I=0:0
- SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,4,B))
- if B<1
- QUIT
- WRITE !,?3,^LR(LRDFN,"MI",LRIDT,4,B,0)
- +7 QUIT
- BUG SET LRTUS=$PIECE(^LR(LRDFN,"MI",LRIDT,1),U,2)
- SET DZ=$PIECE(^(1),U,3)
- SET LRUS=$PIECE(^(1),U,6)
- SET LRNS=$PIECE(^(1),U,5)
- SET Y=$PIECE(^(1),U)
- DO D^LRU
- +1 if $Y>(IOSL-LRFLIP)
- DO WAIT^LROR4
- if LREND
- QUIT
- +2 if LRHC
- WRITE !
- WRITE !,"* BACTERIOLOGY ",$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_" TECH CODE: "_DZ
- +3 SET LRPRE=19
- DO PRE^LRMIPSU
- +4 IF $LENGTH(LRUS)
- WRITE !,"URINE SCREEN: "_$SELECT(LRUS="N":"Negative",LRUS="P":"Positive",1:LRUS)
- if LRHC
- WRITE !
- +5 IF $LENGTH(LRNS)
- WRITE !,"SPUTUM SCREEN: ",LRNS
- if LRHC
- WRITE !
- +6 QUIT
- GRAM WRITE !,"GRAM STAIN:"
- SET LRGRM=0
- FOR I=0:0
- SET LRGRM=+$ORDER(^LR(LRDFN,"MI",LRIDT,2,LRGRM))
- if LRGRM<1
- QUIT
- WRITE ?14,^(LRGRM,0),!
- +1 if LRHC
- WRITE !
- +2 QUIT
- BSMEAR WRITE !,"BACTERIOLOGY SMEAR/PREP:",!
- SET LRMYC=0
- FOR I=0:0
- SET LRMYC=+$ORDER(^LR(LRDFN,"MI",LRIDT,25,LRMYC))
- if LRMYC<1
- QUIT
- WRITE ?5,^(LRMYC,0),!
- +1 QUIT
- BRMK SET (LRBUG,LR2ORMOR)=0
- FOR LRAX=1,2
- SET LRBUG=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG))
- if LRBUG<1
- QUIT
- if LRAX=2
- SET LR2ORMOR=1
- +1 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
- +2 QUIT
- LST SET (LRBUG(LRAX),LRORG)=$PIECE(^LR(LRDFN,"MI",LRIDT,3,LRBUG,0),U)
- SET LRQU=$PIECE(^(0),U,2)
- SET LRSSD=$PIECE(^(0),U,3,8)
- SET LRORG=$PIECE(^LAB(61.2,LRORG,0),U)
- +1 IF LRSSD'?."^"
- SET LRSIC1=$PIECE(LRSSD,U)
- SET LRSBC1=$PIECE(LRSSD,U,2)
- SET LRDRTM1=$PIECE(LRSSD,U,3)
- SET LRSIC2=$PIECE(LRSSD,U,4)
- SET LRSBC2=$PIECE(LRSSD,U,5)
- SET LRDRTM2=$PIECE(LRSSD,U,6)
- SET LRSSD=1
- +2 if LRHC
- WRITE !
- if LRAX=1
- WRITE !,"CULTURE RESULTS:"
- if LRAX>1
- WRITE !
- WRITE ?17,$SELECT(LR2ORMOR:LRBUG_". ",1:""),LRQU,LRORG
- +3 IF LRSSD
- DO FH^LROR4
- if LREND
- QUIT
- DO SSD
- if LRHC
- WRITE !
- +4 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(^(0),U,4)>0
- DO MIC
- +5 IF $DATA(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,0))
- IF $PIECE(^(0),U,4)>0
- DO CMNT
- +6 QUIT
- SSD WRITE !
- SET LRDRTM1=$SELECT(LRDRTM1="P":"PEAK",LRDRTM1="T":"TROUGH",1:LRDRTM1)
- SET LRDRTM2=$SELECT(LRDRTM2="P":"PEAK",LRDRTM2="T":"TROUGH",1:LRDRTM2)
- +1 IF $LENGTH(LRSIC1)
- WRITE !,?20,"SIT "
- if $LENGTH(LRDRTM1)
- WRITE "(",LRDRTM1,")"
- WRITE ": ",LRSIC1
- +2 IF $LENGTH(LRSBC1)
- WRITE !,?20,"SBT "
- if $LENGTH(LRDRTM1)
- WRITE "(",LRDRTM1,")"
- WRITE ": ",LRSBC1
- +3 IF $LENGTH(LRSIC2)
- WRITE !,?20,"SIT "
- if $LENGTH(LRDRTM2)
- WRITE "(",LRDRTM2,")"
- WRITE ": ",LRSIC2
- +4 IF $LENGTH(LRSBC2)
- WRITE !,?20,"SBT "
- if $LENGTH(LRDRTM2)
- WRITE "(",LRDRTM2,")"
- WRITE ": ",LRSBC2
- +5 QUIT
- MIC WRITE !,?18,"Antibiotic"
- SET B=0
- FOR I=0:0
- SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B))
- if B<1
- QUIT
- IF $LENGTH($PIECE(^(B,0),U,2,3))>1
- WRITE ?35,"MIC (ug/ml)",?50,"MBC (ug/ml)"
- +1 SET B=0
- FOR I=0:0
- SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B))
- if B<1
- QUIT
- WRITE !,?18,$PIECE(^(B,0),U),?35,$JUSTIFY($PIECE(^(0),U,2),7),?50,$SELECT($PIECE(^(0),U,3):$JUSTIFY($PIECE(^(0),U,3),7),1:"")
- +2 QUIT
- CMNT SET LRPC=0
- FOR A=0:1
- SET LRPC=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC))
- if LRPC<1
- QUIT
- WRITE !?20
- if A=0
- WRITE "Comment: "
- WRITE ?29,^(LRPC,0)
- +1 QUIT
