55 lines
2.3 KiB
Mathematica
55 lines
2.3 KiB
Mathematica
|
LRMIPSU ;AVAMC/REG/SLC/CJS/BA - MICRO PATIENT REPORT ; 10/7/87 08:42 ;
|
||
|
|
;;5.2;LAB SERVICE;;Sep 27, 1994
|
||
|
|
FH ;from LRMIPSZ1, LRMIPSZ2, LRMIPSZ5
|
||
|
|
D:$Y>(IOSL-LRFLIP) FOOT,HDR
|
||
|
|
Q
|
||
|
|
FHR ;from LRMIPSZ1, LRMIPSZ2
|
||
|
|
D:$Y>(IOSL-LRFLIP) FOOT,HDR Q:LREND D REFS
|
||
|
|
Q
|
||
|
|
REFS ;from LRMIPSZ1
|
||
|
|
S B=1,LREF=0
|
||
|
|
F I=0:0 S LREF=$O(LRBUG(LREF)) Q:LREF="" S LRIFN=LRBUG(LREF) D LIST Q:LREND
|
||
|
|
K LRBUG
|
||
|
|
Q
|
||
|
|
LIST Q:'$D(^LAB(61.2,LRIFN,"JR",0))
|
||
|
|
S LRNUM=0
|
||
|
|
F I=0:0 S LRNUM=$O(^LAB(61.2,LRIFN,"JR",LRNUM)) Q:LRNUM="" D WR Q:LREND
|
||
|
|
Q
|
||
|
|
WR S X1=^LAB(61.2,LRIFN,"JR",LRNUM,0) Q:$P(X1,U,7)'=1
|
||
|
|
D:$Y>(IOSL-LRFLIP-2) FOOT,HDR Q:LREND
|
||
|
|
W:B=1 !!,"Reference(s): " S B=0
|
||
|
|
W !!,$J(LREF,2),". ",$P(X1,U,2),!,$P(X1,U)
|
||
|
|
W ! W:$L($P(X1,U,3)) $P(^LAB(95,$P(X1,U,3),0),U)," ",$P(X1,U,4),":"
|
||
|
|
W $P(X1,U,5) W:$L($P(X1,U,6)) ",",$E($P(X1,U,6),1,3)+1700
|
||
|
|
Q
|
||
|
|
FOOT ;from LRMIPSZ1
|
||
|
|
F X=1:1 W ! Q:$Y>(IOSL-LRFLIP)
|
||
|
|
Q:'LRHC W !,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
|
||
|
|
W:LRCS'=LRST !,"Site/Specimen: ",LRST W !!
|
||
|
|
W !!,PNM,?$X+3,SSN,?$X+3 W:$D(IA) IA W ?60," ROUTING: ",LRPATLOC,!
|
||
|
|
W $$INS^LRU," LABORATORY",?62,LRACC,!,"MICROBIOLOGY",?62,"page ",LRPG,!
|
||
|
|
Q
|
||
|
|
HDR ;from LRMIPSZ1
|
||
|
|
S LRPG=LRPG+1 D:LRPG>1 WAIT Q:LREND
|
||
|
|
W:($G(LRJ02))!($G(LRJ0))!($E(IOST,1,2)="C-") @IOF S LRJ02=1
|
||
|
|
W !,PNM,?20," ",SSN,?35," AGE: ",AGE W:$L(LRWRD) ?46,"LOC: ",LRWRD
|
||
|
|
W ?61," ",LRDT0 S A8=$P($H,",",2),Y=A8\3600_":"_$E((A8\60#60+100),2,3)
|
||
|
|
W " ",Y W:LRHC !
|
||
|
|
W:LRPG=1 !?27,"----MICROBIOLOGY----",?70,"page 1"
|
||
|
|
I $D(DUZ("AG")),$L(DUZ("AG")),"ARMYAFN"[DUZ("AG") D ^LRAIPRIV
|
||
|
|
I '$D(LRH),LRHC W !?32,$S($D(^XUSEC("LRLAB",DUZ))&'$D(LRWRDVEW):"LAB",1:"CHART")," COPY"
|
||
|
|
W:LRPG=1 !,"Accession: ",LRACC,?40,"Received: ",LRRC
|
||
|
|
W !,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
|
||
|
|
I LRCS'=LRST,LRPG=1 W !,"Site/Specimen: ",LRST
|
||
|
|
I LRPG=1 W !,"Provider: ",LRDOC,! W:$L(LRCMNT) "Comment on specimen: ",LRCMNT,!
|
||
|
|
W:LRPG>1 !?20,">> CONTINUATION OF ",LRACC," <<",?70,"page ",LRPG
|
||
|
|
Q
|
||
|
|
WAIT ; from LRMIPSZ1, LRMIPSZ2
|
||
|
|
F I=$Y:1:IOSL-3 W !
|
||
|
|
I 'LRHC W !,PNM,?25," ",SSN," ROUTING: ",LRPATLOC,?59," PRESS '^' TO STOP " R X:DTIME S:X="" X=1 S:(".^"[X)!('$T) LREND=1
|
||
|
|
Q
|
||
|
|
PRE ;from LRMIPSZ2, LRMIPSZ3, LRMIPSZ4
|
||
|
|
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)
|
||
|
|
W !
|
||
|
|
Q
|