| 1 | LRMIPSU ;AVAMC/REG/SLC/CJS/BA - MICRO PATIENT REPORT ; 10/7/87 08:42 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | FH ;from LRMIPSZ1, LRMIPSZ2, LRMIPSZ5
|
|---|
| 4 | D:$Y>(IOSL-LRFLIP) FOOT,HDR
|
|---|
| 5 | Q
|
|---|
| 6 | FHR ;from LRMIPSZ1, LRMIPSZ2
|
|---|
| 7 | D:$Y>(IOSL-LRFLIP) FOOT,HDR Q:LREND D REFS
|
|---|
| 8 | Q
|
|---|
| 9 | REFS ;from LRMIPSZ1
|
|---|
| 10 | S B=1,LREF=0
|
|---|
| 11 | F I=0:0 S LREF=$O(LRBUG(LREF)) Q:LREF="" S LRIFN=LRBUG(LREF) D LIST Q:LREND
|
|---|
| 12 | K LRBUG
|
|---|
| 13 | Q
|
|---|
| 14 | LIST Q:'$D(^LAB(61.2,LRIFN,"JR",0))
|
|---|
| 15 | S LRNUM=0
|
|---|
| 16 | F I=0:0 S LRNUM=$O(^LAB(61.2,LRIFN,"JR",LRNUM)) Q:LRNUM="" D WR Q:LREND
|
|---|
| 17 | Q
|
|---|
| 18 | WR S X1=^LAB(61.2,LRIFN,"JR",LRNUM,0) Q:$P(X1,U,7)'=1
|
|---|
| 19 | D:$Y>(IOSL-LRFLIP-2) FOOT,HDR Q:LREND
|
|---|
| 20 | W:B=1 !!,"Reference(s): " S B=0
|
|---|
| 21 | W !!,$J(LREF,2),". ",$P(X1,U,2),!,$P(X1,U)
|
|---|
| 22 | W ! W:$L($P(X1,U,3)) $P(^LAB(95,$P(X1,U,3),0),U)," ",$P(X1,U,4),":"
|
|---|
| 23 | W $P(X1,U,5) W:$L($P(X1,U,6)) ",",$E($P(X1,U,6),1,3)+1700
|
|---|
| 24 | Q
|
|---|
| 25 | FOOT ;from LRMIPSZ1
|
|---|
| 26 | F X=1:1 W ! Q:$Y>(IOSL-LRFLIP)
|
|---|
| 27 | Q:'LRHC W !,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
|
|---|
| 28 | W:LRCS'=LRST !,"Site/Specimen: ",LRST W !!
|
|---|
| 29 | W !!,PNM,?$X+3,SSN,?$X+3 W:$D(IA) IA W ?60," ROUTING: ",LRPATLOC,!
|
|---|
| 30 | W $$INS^LRU," LABORATORY",?62,LRACC,!,"MICROBIOLOGY",?62,"page ",LRPG,!
|
|---|
| 31 | Q
|
|---|
| 32 | HDR ;from LRMIPSZ1
|
|---|
| 33 | S LRPG=LRPG+1 D:LRPG>1 WAIT Q:LREND
|
|---|
| 34 | W:($G(LRJ02))!($G(LRJ0))!($E(IOST,1,2)="C-") @IOF S LRJ02=1
|
|---|
| 35 | W !,PNM,?20," ",SSN,?35," AGE: ",AGE W:$L(LRWRD) ?46,"LOC: ",LRWRD
|
|---|
| 36 | W ?61," ",LRDT0 S A8=$P($H,",",2),Y=A8\3600_":"_$E((A8\60#60+100),2,3)
|
|---|
| 37 | W " ",Y W:LRHC !
|
|---|
| 38 | W:LRPG=1 !?27,"----MICROBIOLOGY----",?70,"page 1"
|
|---|
| 39 | I $D(DUZ("AG")),$L(DUZ("AG")),"ARMYAFN"[DUZ("AG") D ^LRAIPRIV
|
|---|
| 40 | I '$D(LRH),LRHC W !?32,$S($D(^XUSEC("LRLAB",DUZ))&'$D(LRWRDVEW):"LAB",1:"CHART")," COPY"
|
|---|
| 41 | W:LRPG=1 !,"Accession: ",LRACC,?40,"Received: ",LRRC
|
|---|
| 42 | W !,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
|
|---|
| 43 | I LRCS'=LRST,LRPG=1 W !,"Site/Specimen: ",LRST
|
|---|
| 44 | I LRPG=1 W !,"Provider: ",LRDOC,! W:$L(LRCMNT) "Comment on specimen: ",LRCMNT,!
|
|---|
| 45 | W:LRPG>1 !?20,">> CONTINUATION OF ",LRACC," <<",?70,"page ",LRPG
|
|---|
| 46 | Q
|
|---|
| 47 | WAIT ; from LRMIPSZ1, LRMIPSZ2
|
|---|
| 48 | F I=$Y:1:IOSL-3 W !
|
|---|
| 49 | I 'LRHC W !,PNM,?25," ",SSN," ROUTING: ",LRPATLOC,?59," PRESS '^' TO STOP " R X:DTIME S:X="" X=1 S:(".^"[X)!('$T) LREND=1
|
|---|
| 50 | Q
|
|---|
| 51 | PRE ;from LRMIPSZ2, LRMIPSZ3, LRMIPSZ4
|
|---|
| 52 | Q:LRTUS["F"&('$D(^XUSEC("LRLAB",DUZ))!$D(LRWRDVEW)) W:+$O(^LR(LRDFN,"MI",LRIDT,LRPRE,0)) !,"Preliminary Comments: " S J=0 F I=0:0 S J=+$O(^LR(LRDFN,"MI",LRIDT,LRPRE,J)) Q:J<1 W !?3,^(J,0)
|
|---|
| 53 | W !
|
|---|
| 54 | Q
|
|---|
