source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAC1.m@ 1806

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1LRAC1 ;SLC/DCM/MILW/JMC - CUMULATIVE CONT. ;2/19/91 09:55 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3LRDFN S LRTNN=2
4 F LRDFN=LRDFN:0 S LRDFN=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM,LRDFN)) K LRTRUE Q:LRDFN<1 I LRRE!('^(LRDFN)) S LRIL=1 D PAT S:LRLLOC["FILE ROOM" ^TMP($J,"SSN",$S(LRDPF=2:"A"_$E(SSN,10,11)_$E(SSN,8,9)_$E(SSN,1,3)_$E(SSN,5,6),1:LRNM),LRDFN)=""
5 Q
6PAT ;from LRACM3
7 Q:$D(^LR(LRDFN,0))[0
8 S DFN=$P(^LR(LRDFN,0),U,3),LRDPF=+$P(^(0),U,2)
9 D PT^LRX Q:LRLLOC["FILE ROOM" S SSN=" "_SSN_" "
10PAT1 ;from LRACFILE
11 L +^LAC(LRXLR,LRDFN) I '$D(^LAC(LRXLR,LRDFN,0)) S ^(0)=LRDFN,^LAC(LRXLR,"B",LRDFN,LRDFN)="",LRZO="^LAC("""_LRXLR_""",",LRZ1=64.7,LRZ3=LRDFN D Z^LRWU
12 S:'$D(^LAC(LRXLR,LRDFN,"MISC",1,0)) ^(0)="MISCELLANEOUS TESTS^"
13 D:'$D(LRCALE) LRCALE^LRAC2 DO:'LRRE FIDT DO ENT^LRAC3 K LRMISC
14 I 'LRRE S $P(^LAC(LRXLR,LRDFN,0),U,2)=LRDT S:$D(LRRPTN) $P(^LAB(64.5,1,3,LRRPTN,0),U,4,6)=LRLLOC_U_LRNM_U_LRDFN S $P(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM,LRDFN),U)=1
15 L -^LAC(LRXLR,LRDFN)
16MICRO ;from LRACM3
17 Q:'$D(^LRO(68,"MI",LRDFN))
18 S LRZ=$P(^LAB(64.5,1,0),U,5)
19 S:'$D(LRUNKNOW) LRUNKNOW=$P(^LAB(69.9,1,1),U,5)
20 S (LRONESPC,LRONETST)="",LREND=0
21 S LRWRDVEW="",LRSB=0 S LRIDT=0
22 F S LRIDT=$O(^LRO(68,"MI",LRDFN,LRIDT)) G:LRIDT<1 MIEND D ZIP,FORP
23FORP I $D(^LR(LRDFN,"MI",LRIDT,0)) S LRII=0 F S LRII=$O(^LRO(68,"MI",LRDFN,LRIDT,LRII)) Q:LRII<1 I $D(^LR(LRDFN,"MI",LRIDT,LRII)) S LRSB=LRII,LRZA=$P(^(LRII),U,2) D:(LRZ="F"&(LRZA="F"))!(LRZ="P") EN1^LRMIPC D FORP1
24 Q
25FORP1 S LRLLOC=LRNLOC S:'LRRE ^LAC("LRKILL",LRDFN,"MI",LRIDT,LRII)="",^LRO(68,"MI",LRDFN,LRIDT,LRII)=1
26 Q
27MIEND K %,A,A1,AGE,B,B1,DFN,DOB,DZ,I,J,LR2ORMOR,LRAA,LRACC,LRACN,LRAD,LRADM
28 K LRADX,LRAFS,LRAX,LRBUG,LRCMNT,LRCOMTAB,LRCS,LRDCOM,LREF,LREND,LRIFN
29 K LRLLT,LRMD,LRNLOC,LRNS,LROK,LRONESPC,LRONETST,LRORG,LRPRE,LRPRINT
30 K LRPG,LRQU,LRRC,LRSPEC,LRSPZ,LRSSD,LRST,LRTK,LRTS,LRTSTS,LRTUS,LRUS
31 K LRWRD,LRZ,LRZA,P,SEX,SSN,X,Y
32 Q
33FIDT S LRIDT=0
34 F S LRIDT=$O(^LRO(68,"AC",LRDFN,LRIDT)) Q:LRIDT<1 D LRIDT^LRAC2
35 Q
36LRLTR ;from LRACM
37 I $D(LRLOCB) S Y=$S(LRLOCB?1N.N&(LRLLOC?1N.N):1,LRLOCB?1N.N&(LRLLOC'?1N.N):2,LRLOCB'?1N.N&(LRLLOC'?1N.N):3,1:4) Q:Y=1&(LRLLOC>LRLOCB)!(Y=2)!(Y=3&(LRLLOC]LRLOCB))
38 I LRLLOC["FILE ROOM",'LRRE,$P($G(^LAB(64.5,1,6)),U,2),'$P($G(^LAB(64.5,1,3,LRRPTN,.1)),U,3) Q
39 ; If location contains "FILE ROOM", not a reprint, site using separate file room, and not a file room report then quit.
40 W @IOF S LRLTR=$E(LRLLOC,1,4) D ^LRLTR S:'$D(LRTRUE) LRNM=-1
41 D LRNM D:LRLLOC["FILE ROOM" ENT^LRACFILE Q
42LRNM F Q=0:0 S:'$D(LRTRUE) LRNM=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM)) Q:LRNM="" S:'$D(LRTRUE) LRDFN=0 D LRDFN I $D(LRNMA) Q:LRNMA=LRNM
43 Q
44ZIP I '$D(^LR(LRDFN,"MI",LRIDT,0)) K ^LRO(68,"MI",LRDFN,LRIDT) Q
45 S LRNLOC=LRLLOC
46 Q
47LRLLOC F Q=0:0 S:'$D(LRTRUE) LRLLOC=$O(^LRO(69,LRDT,1,"AR",LRLLOC)) Q:LRLLOC="" D LRLTR
48 Q
49ENT ;from LRACM1
50 S:$D(ZTQUEUED) ZTREQ="@"
51 I $D(IOP) S LRX=$S($D(DUZ(0)):DUZ(0),1:""),DUZ(0)="" D ^%ZIS S DUZ(0)=LRX K IOP
52 I 'LRRE,'$P(^LAB(64.5,1,3,LRRPTN,0),U,7) S %DT="T",X="N" D ^%DT S $P(^LAB(64.5,1,3,LRRPTN,0),U,7)=Y
53 U IO K ^TMP($J) D DT^LRX S LRCDT=LRDT0,LRAC=1
54 G:LRRE DO S X=$P(^LAB(64.5,1,3,LRRPTN,0),U,4,8),Y=^(0),LRLLOC=$S(LRDT=LRLDT&($L($P(X,U,1))):$P(X,U,1),1:$P(Y,U,2)),LRLOCB=$P(Y,U,3)
55 S LRNM=$S(LRDT=LRLDT&($L($P(X,U,2))):$P(X,U,2),1:-1)
56 S LRDFN=$S(LRDT=LRLDT:$P(X,U,3),1:0)
57 I $L(LRLLOC),$D(^LRO(69,LRDT,1,"AR",LRLLOC)) S LRTRUE=1
58DO DO LRLLOC
59END S LRLTR="END" W @IOF D ^LRLTR
60 I '$D(LREN),'LRRE,'$P(^LAB(64.5,1,3,LRRPTN,0),U,8) S %DT="T",X="N" D ^%DT S $P(^LAB(64.5,1,3,LRRPTN,0),U,8)=Y
61 D KILL K ^TMP($J),^TMP("LRLTR",$J) D ^%ZISC
62 Q
63KILL K LRG,LRADD,LRCNT,LRCTN,LRCTR,LRCTRR,LRDT,LRDT1,LRFALT,LRFD1,LRFDE
64 K LRFFDT,LRIF,LRIPG,LRIV,LRKL,LRLTR,LRNOT,LRNUM,LRNX,LRNXSW,LRPG2,LRPPT
65 K LRVAR,LRXLR,LRYDT,LRRPTN,X1,LRJ02
66 Q
Note: See TracBrowser for help on using the repository browser.