67 lines
3.6 KiB
Mathematica
67 lines
3.6 KiB
Mathematica
LRAC1 ;SLC/DCM/MILW/JMC - CUMULATIVE CONT. ;2/19/91 09:55 ;
|
|
;;5.2;LAB SERVICE;;Sep 27, 1994
|
|
LRDFN S LRTNN=2
|
|
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)=""
|
|
Q
|
|
PAT ;from LRACM3
|
|
Q:$D(^LR(LRDFN,0))[0
|
|
S DFN=$P(^LR(LRDFN,0),U,3),LRDPF=+$P(^(0),U,2)
|
|
D PT^LRX Q:LRLLOC["FILE ROOM" S SSN=" "_SSN_" "
|
|
PAT1 ;from LRACFILE
|
|
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
|
|
S:'$D(^LAC(LRXLR,LRDFN,"MISC",1,0)) ^(0)="MISCELLANEOUS TESTS^"
|
|
D:'$D(LRCALE) LRCALE^LRAC2 DO:'LRRE FIDT DO ENT^LRAC3 K LRMISC
|
|
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
|
|
L -^LAC(LRXLR,LRDFN)
|
|
MICRO ;from LRACM3
|
|
Q:'$D(^LRO(68,"MI",LRDFN))
|
|
S LRZ=$P(^LAB(64.5,1,0),U,5)
|
|
S:'$D(LRUNKNOW) LRUNKNOW=$P(^LAB(69.9,1,1),U,5)
|
|
S (LRONESPC,LRONETST)="",LREND=0
|
|
S LRWRDVEW="",LRSB=0 S LRIDT=0
|
|
F S LRIDT=$O(^LRO(68,"MI",LRDFN,LRIDT)) G:LRIDT<1 MIEND D ZIP,FORP
|
|
FORP 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
|
|
Q
|
|
FORP1 S LRLLOC=LRNLOC S:'LRRE ^LAC("LRKILL",LRDFN,"MI",LRIDT,LRII)="",^LRO(68,"MI",LRDFN,LRIDT,LRII)=1
|
|
Q
|
|
MIEND K %,A,A1,AGE,B,B1,DFN,DOB,DZ,I,J,LR2ORMOR,LRAA,LRACC,LRACN,LRAD,LRADM
|
|
K LRADX,LRAFS,LRAX,LRBUG,LRCMNT,LRCOMTAB,LRCS,LRDCOM,LREF,LREND,LRIFN
|
|
K LRLLT,LRMD,LRNLOC,LRNS,LROK,LRONESPC,LRONETST,LRORG,LRPRE,LRPRINT
|
|
K LRPG,LRQU,LRRC,LRSPEC,LRSPZ,LRSSD,LRST,LRTK,LRTS,LRTSTS,LRTUS,LRUS
|
|
K LRWRD,LRZ,LRZA,P,SEX,SSN,X,Y
|
|
Q
|
|
FIDT S LRIDT=0
|
|
F S LRIDT=$O(^LRO(68,"AC",LRDFN,LRIDT)) Q:LRIDT<1 D LRIDT^LRAC2
|
|
Q
|
|
LRLTR ;from LRACM
|
|
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))
|
|
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
|
|
; If location contains "FILE ROOM", not a reprint, site using separate file room, and not a file room report then quit.
|
|
W @IOF S LRLTR=$E(LRLLOC,1,4) D ^LRLTR S:'$D(LRTRUE) LRNM=-1
|
|
D LRNM D:LRLLOC["FILE ROOM" ENT^LRACFILE Q
|
|
LRNM 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
|
|
Q
|
|
ZIP I '$D(^LR(LRDFN,"MI",LRIDT,0)) K ^LRO(68,"MI",LRDFN,LRIDT) Q
|
|
S LRNLOC=LRLLOC
|
|
Q
|
|
LRLLOC F Q=0:0 S:'$D(LRTRUE) LRLLOC=$O(^LRO(69,LRDT,1,"AR",LRLLOC)) Q:LRLLOC="" D LRLTR
|
|
Q
|
|
ENT ;from LRACM1
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
I $D(IOP) S LRX=$S($D(DUZ(0)):DUZ(0),1:""),DUZ(0)="" D ^%ZIS S DUZ(0)=LRX K IOP
|
|
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
|
|
U IO K ^TMP($J) D DT^LRX S LRCDT=LRDT0,LRAC=1
|
|
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)
|
|
S LRNM=$S(LRDT=LRLDT&($L($P(X,U,2))):$P(X,U,2),1:-1)
|
|
S LRDFN=$S(LRDT=LRLDT:$P(X,U,3),1:0)
|
|
I $L(LRLLOC),$D(^LRO(69,LRDT,1,"AR",LRLLOC)) S LRTRUE=1
|
|
DO DO LRLLOC
|
|
END S LRLTR="END" W @IOF D ^LRLTR
|
|
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
|
|
D KILL K ^TMP($J),^TMP("LRLTR",$J) D ^%ZISC
|
|
Q
|
|
KILL K LRG,LRADD,LRCNT,LRCTN,LRCTR,LRCTRR,LRDT,LRDT1,LRFALT,LRFD1,LRFDE
|
|
K LRFFDT,LRIF,LRIPG,LRIV,LRKL,LRLTR,LRNOT,LRNUM,LRNX,LRNXSW,LRPG2,LRPPT
|
|
K LRVAR,LRXLR,LRYDT,LRRPTN,X1,LRJ02
|
|
Q
|