source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRMISEZ1.m@ 1801

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1LRMISEZ1 ;AVAMC/REG/SLC/BA - MICROBIOLOGY INFECTION CONTROL DATA ;4/17/91 14:29 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3DQ ;dequeued from LRMISEZ
4 U IO K ^TMP($J),Z S:$D(ZTQUEUED) ZTREQ="@" S (LRAO,O)=0
5 F I=0:0 S LRAO=$O(^LAB(62.06,"AO",LRAO)) Q:LRAO<.001 S J=$O(^LAB(62.06,"AO",LRAO,0)) I J>0,$D(^LAB(62.06,J,0)),$L($P(^(0),U,5)) S O=O+1,B(O)=J_U_$P(^(0),U,5) S LRBN=$P(^(0),U,2) I LRBN,$D(LRAP(LRBN)) S $P(B(O),U,3)=LRAP(LRBN)
6 S B=0 F I=0:0 S B=$O(B(B)) Q:B="" S LRZ=$P(B(B),U),LRZ(LRZ)=B
7 F I=0:0 S LRAD=$O(^LRO(68,LRAA,1,LRAD)) Q:LRAD=""!(LRAD>LRYRL) D AC
8 D ^LRMISEZ2 W !
9 Q
10AC S LRTK=LRSTAR-.00001 F I=0:0 S LRTK=$O(^LRO(68,LRAA,1,LRAD,1,"AD",LRTK)) Q:LRTK=""!(LRTK>LAST) D AC1
11 Q
12AC1 S LRAC=0 F I=0:0 S LRAC=$O(^LRO(68,LRAA,1,LRAD,1,"AD",LRTK,LRAC)) Q:LRAC="" I $D(^LRO(68,LRAA,1,LRAD,1,LRAC,0)) S LRND=^(0) I $D(^(3)) S LRIDT=9999999-^(3) D SET
13 Q
14SET S LRDFN=+LRND Q:'$D(^LR(LRDFN,"MI",LRIDT,3,0))
15 S LRDAT=+^LR(LRDFN,"MI",LRIDT,0)
16 I LRLOS S LROK=1 D LOS Q:'LROK
17 I LRSIT(1)="S" S LRSIT=$S($L($P(^LR(LRDFN,"MI",LRIDT,0),U,5)):$P(^(0),U,5),1:"Unknown") I LRSIT S LRSIT=$S($D(^LAB(61,LRSIT,0)):$E($P(^(0),U),1,8)_U_LRSIT_U,1:"Unknown")
18 I LRSIT(1)'="S" S LRSIT=$S($L($P(^LR(LRDFN,"MI",LRIDT,0),U,11)):$P(^(0),U,11),1:"Unknown") I LRSIT S LRSIT=$S($D(^LAB(62,LRSIT,0)):$E($P(^(0),U),1,8)_U_LRSIT_U,1:"Unknown")
19 S LRDOC=$S($L($P(^LR(LRDFN,"MI",LRIDT,0),U,7)):$P(^(0),U,7),1:"Unknown") I LRDOC S X=LRDOC D DOC^LRX S ^TMP($J,"XDOC",+X)=LRDOC,LRDOC=$E(LRDOC,1,15)_U_+X
20 Q:'$D(^LR(LRDFN,"MI",LRIDT,1)) Q:'+^(1)
21 S LRPF=^DIC($P(^LR(LRDFN,0),U,2),0,"GL"),LRDPF=+$P(@(LRPF_"0)"),U,2),DFN=$P(^LR(LRDFN,0),U,3),LRPPT=@(LRPF_DFN_",0)")
22 S LRNAME=$E($P(LRPPT,U),1,15)_U_LRDFN,SSN=$P(LRPPT,U,9),^TMP($J,"XPAT",LRDFN)=$P(LRPPT,U)
23 S LROR=0,LRMY=$E(LRTK,1,5),LRLLOC=$E($P(LRND,U,7),1,7) S:'$L(LRLLOC) LRLLOC="UNKNOWN" S:LRLLOC["DIED" LRLLOC="EXPIRED"
24 D ^LRMISEZB
25 Q
26LOS S DFN=$S($P(^LR(LRDFN,0),"^",2)=2:$P(^(0),"^",3),1:"") Q:'DFN S X=$O(^DGPM("APID",DFN,0)) I X S X=$O(^DGPM("APID",DFN,X,0)) I X,$D(^DGPM(X,0)),$P(^(0),"^",14) S X=$P(^(0),"^",14) S X=$S($D(^DGPM(X,0)):^(0),1:"") ;MAS
27 S:'X LROK=0 Q:'X S LRADMD=+X I $P(X,"^",17) S LRDCHD=$P(X,"^",17) S LRDCHD=$S($D(^DGPM(LRDCHD,0)):$P(^(0),U,1),1:"") I LRDCHD<LRDAT S LROK=0 Q ;MAS
28 S X1=LRDAT,X2=LRADMD D ^%DTC I X<LRLOS S LROK=0
29 Q
Note: See TracBrowser for help on using the repository browser.