source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRUCN.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1LRUCN ;AVAMC/REG/CYM - LAB CONSULTS ;2/18/98 12:34 ;
2 ;;5.2;LAB SERVICE;**203,247**;Sep 27, 1994
3 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
4 D END W !!?20,"CONSULTATION REPORT"
5 S DIC=65.9,DIC(0)="AEQMZ",DIC("A")="Select CONSULTATION: ",DIC("S")="I $P(^(0),U,2)=2" D ^DIC K DIC G:Y<1 END S LRL(1)=$P(Y,U,2),LRL=+Y,LRAA=$P(Y(0),U,9) I 'LRAA W $C(7),!,"Must have an accession area for ",LRL(1) G END
6 S LRSS=$P(^LRO(68,LRAA,0),U,2),LRDPAF=1
7PT D ^LRDPA G:LRDFN<1 END
8 I LRL(1)="DIRECT COOMBS TEST REPORT" D ASK G:LRI<1 END
9 S ZTRTN="QUE^LRUCN" D BEG^LRUTL G:POP!($D(ZTSK)) END
10QUE U IO S %DT="",X="T" D ^%DT,D^LRU S LRD=Y D L^LRU,S^LRU,H I '$D(^LAB(65.9,LRL,0)) W !,LRL(1)," entry in LAB LETTER file (#65.9) was deleted." G OUT
11 D SET D:LRSS="BB" ^LRUCNBB
12OUT D END^LRUTL,END Q
13H S LRQ=LRQ+1 W @IOF,!!!!,LR("%"),!?5,"CLINICAL RECORD ",LRL(1),?51,"|" W:LRQ>1 ?(IOM-8),"Pg:",LRQ W !?5,LRQ(1),?51,"|" W:$D(LRI) "Specimen:",LRI(1) W !,LR("%") Q
14W W !,LR("%") Q
15F F X=0:0 Q:$Y>(IOSL-12) W !
16 D W W !?60,"(",$S($D(LRE):"End of report",1:"See next page"),")",!,LRS,!,LRS(1),?60,LRD
17 D W W !,LRP,?40,"LOC: ",LRLLOC,!,"SSN:",SSN,?16,"SEX:",SEX," DOB: ",DOB W:$D(AGE) " AGE:",AGE W !
18 W:$L(LRADM) "ADM:",$E(LRADM,1,12) W:$D(LRADX) ?17,"DX:",$E(LRADX,1,28) W:$L(LRMD) ?46,LRMD Q
19SET S X=^LAB(65.9,LRL,0),DIWL=$S($P(X,U,5):$P(X,U,5),1:5),DIWR=IOM-$P(X,U,6),DIWF=$S($P(X,U,7):"D",1:""),DIWF=DIWF_$S($P(X,U,8):"R",1:"")
20 S X=$S($D(^LAB(65.9,LRL,3)):^(3),1:""),LRS=$P(X,"^"),LRS(1)=$P(X,"^",2) Q
21ASK I '$O(^LR(LRDFN,LRSS,0)) S LRI=-1 W $C(7),!!,"There are no specimen dates for ",LRP," ",SSN Q
22 K DIC S DIC="^LR(LRDFN,LRSS,",DIC(0)="AEQM" D ^DIC K DIC S LRI=+Y,Y=$P(Y,U,2),LRI(1)=$$FMTE^XLFDT(Y,"M") Q
23END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.