source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LROR4.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1LROR4 ;SLC/DCM - MICRO DETAILED DISPLAY ON ORDERS ;4/17/91 14:29 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 ;
4EN ;from LROR2
5 S LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRAD=$E(LRLLT)_$P(LRACC," ",2)_"0000",X=$P(LRACC," "),DIC=68,DIC(0)="M"
6 I $L(X) D ^DIC S LRAA=+Y,LRAN=+$P(LRACC," ",3),LRCMNT=$S($D(^LR(LRDFN,"MI",LRIDT,99)):^(99),1:""),LRPG=0 D A Q:LREND
7 Q
8A ;
9 S LRSPEC=$P(LRLLT,U,5) I LRONESPC'="",LRSPEC'=LRONESPC Q
10 D RPT
11 K %,A8,A,AB,B,B1,B2,B3,C,DZ,IA,LR1PASS,LR2ORMOR,LRABCNT,LRACNT,LRADM,LRADX,LRAFS,LRAMT,LRAX,LRBN,LRBRR,LRBUG,LRCOMTAB,LRCS,LRDCOM,LRDOC,LRDRTM1,LRDRTM2,LREF,LRFLIP,LRFMT,LRGRM,LRHC,LRIFN,LRINT,LRPATLOC,LRMYC,LRNS,LRNUM
12 K LRORG,LRPAR,LRPC,LRPRE,LRPRINT,LRQU,LRRC,LRRES,LRSBC1,LRSBC2,LRSET,LRSIC1,LRSIC2,LRSPEC,LRSSD,LRST,LRTA,LRTB,LRTBA,LRTBC,LRTBS,LRTK,LRTS,LRTSTS,LRTUS,LRUS,LRWRD,N
13 Q
14RPT S:'$D(LRSB) LRSB=0 S LRPRINT=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,4)):"",1:1),LRHC=$S(IOST'["C-":1,1:0),LRFLIP=$S(LRHC:11,1:6)
15 I $D(DUZ("AG")),$L(DUZ("AG")),"ARMYAFN"[DUZ("AG"),LRDPF=2 S LRFDT=9999999-LRIDT D REG^LRAC9 K LRFDT
16 K DIC D DT^LRX S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX S Y=DOB D:Y D^LRU S DOB=Y,LRPATLOC=$P(LRLLT,U,8)
17 S (LRADM,LRADX)="",LRWRD=$S($D(LRWRD):LRWRD,1:"") I LRDPF=2 S N=$O(^DGPM("APID",DFN,0)) I N S N=$O(^(N,0)) I N S X=^DGPM(N,0) I $P(X,"^",14),$D(^DGPM($P(X,"^",14),0)) S X=^(0),Y=+X,LRADX=$P(^(0),"^",10) D:Y D^LRU S LRADM=Y ;MAS
18 S LRCS=$S($D(^LAB(62,+$P(LRLLT,U,11),0)):$P(^(0),U),1:"")
19 S LRTK=$P(LRLLT,U),LRRC=$P(LRLLT,U,10),LRST=$S(LRSPEC:$P(^LAB(61,LRSPEC,0),U),1:""),Y=LRTK D D^LRU S LRTK=Y,Y=LRRC D D^LRU S LRRC=Y
20 S X=$P(LRLLT,U,7) D DOC^LRX
21 K ^TMP("LR",$J,"T"),LRTSTS S LRBRR=0 F I=0:0 S LRBRR=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR)) Q:LRBRR<1 D EN1
22 I 'LRPRINT,LRONETST Q
23 S LRPG=0 D HDR Q:LREND
24 I $D(^TMP("LR",$J,"T")) W !?5,"Test(s) ordered:" S J="" F I=0:0 S J=$O(^TMP("LR",$J,"T",J)) Q:J="" S X=^(J) W ?23,$P(X,U) S Y=$P(X,U,2) D:$L(Y) D^LRU W:$L(Y) ?43," completed: ",Y W !
25 K ^TMP("LR",$J,"T"),LRTSTS W:LRHC !
26 I $D(^LR(LRDFN,"MI",LRIDT,14)) D FH Q:LREND D ANTI^LROR4A
27 I $D(^LR(LRDFN,"MI",LRIDT,1)) D FH Q:LREND D BACT^LROR4A Q:LREND D REFS^LRMIPSU Q:LREND
28 I $D(^LR(LRDFN,"MI",LRIDT,31)) D FH Q:LREND D STER^LRMIPSZ3
29 I $D(^LR(LRDFN,"MI",LRIDT,5)) D FH Q:LREND D PARA^LRMIPSZ3,REFS^LRMIPSU Q:LREND
30 I $D(^LR(LRDFN,"MI",LRIDT,16)) D FH Q:LREND D VIR^LRMIPSZ3,REFS^LRMIPSU Q:LREND
31 I $D(^LR(LRDFN,"MI",LRIDT,11)) D FH Q:LREND D TB^LRMIPSZ4,REFS^LRMIPSU Q:LREND
32 I $D(^LR(LRDFN,"MI",LRIDT,8)) D FH Q:LREND D FUNG^LRMIPSZ4,REFS^LRMIPSU Q:LREND
33 Q
34EN1 S LRTS=+^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR,0),LRTS(1)=$P(^(0),U,5)
35 S:LRTS=LRONETST LRPRINT=1 S LRTSTS=$S($D(^LAB(60,LRTS,0)):$P(^(0),U),1:"deleted test"),^TMP("LR",$J,"T",$S($D(^LAB(60,LRTS,.1)):$P(^(.1),U,6),1:"")_","_LRBRR)=LRTSTS_U_LRTS(1)
36 Q
37FH D:$Y>(IOSL-LRFLIP) HDR
38 Q
39HDR ;
40 S LRPG=LRPG+1 D WAIT Q:LREND D EXT^ORUHDR
41 W !?27,"----MICROBIOLOGY----"
42 I $D(DUZ("AG")),$L(DUZ("AG")),"ARMYAFN"[DUZ("AG") D ^LRAIPRIV
43 I '$D(LRH),LRHC W !?32,$S($D(^XUSEC("LRLAB",DUZ))&'$D(LRWRDVEW):"LAB",1:"CHART")," COPY"
44 W:LRPG=1 !,"Accession: ",LRACC,?47,"Received: ",LRRC
45 W !,"Collection sample: ",LRCS,?40,"Collection date: ",LRTK
46 I LRCS'=LRST,LRPG=1 W !,"Site/Specimen: ",LRST
47 I LRPG=1 W !,"Provider: ",LRDOC,! W:$L(LRCMNT) "Comment on specimen: ",LRCMNT,!
48 W:LRPG>1 !?20,">> CONTINUATION OF ",LRACC," <<"
49 Q
50WAIT ;
51 F I=$Y:1:IOSL-4 W !
52 I 'LRHC D PGBRK^ORUHDR I OREND S LREND=1 Q
53 Q
Note: See TracBrowser for help on using the repository browser.