86 lines
3.8 KiB
Mathematica
86 lines
3.8 KiB
Mathematica
LRCAPDAR ;DALOI/FHS/RBN - LAB DSS RESULTS EXTRACT (LAR)
|
|
;;5.2;LAB SERVICE;**143,169,258,307,326**;Sep 27, 1994
|
|
;
|
|
; Call with Start Date (LRSDT) End Date (LREDT) FileMan format
|
|
; Calling routine should have already purged ^LAR(64.036)
|
|
EN S:$D(ZTQUEUED) ZTREQ="@"
|
|
I $S($G(LRSDT)'?7N:1,$G(LREDT)'?7N:1,1:0) Q
|
|
L +^LAR(64.036):2 G:'$T END
|
|
N DIR,DIC,DIE,X,I,LR3,LRAA,LRAD,LRAN,LRC,LRSPDT,LRSPTM,UID,Y,DLAYGO
|
|
S DLAYGO=64
|
|
D INIT
|
|
I LRSDT>LREDT S X=LRSDT,LRSDT=LREDT,LREDT=X
|
|
S LRX1=9999999-(LRSDT_.0001),LRX2=9999999-(LREDT_.235959)
|
|
S:'$D(^LAR(64.036,0))#2 ^LAR(64.036,0)="LAB DSS LAR EXTRACT^64.036^2"
|
|
LR K LRSP
|
|
S LRDFN=0 F S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 I $P($G(^LR(LRDFN,0)),U,2)=2 S LRN=^(0) D
|
|
. S DFN=$P(LRN,U,3),LRDPF=$P(LRN,U,2)
|
|
. S LRIDT=LRX2 F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1!(LRIDT>LRX1) I $D(^(LRIDT,0)),$P(^(0),U,3) S LRVSPEC=$P(^(0),U,5),LRN0=^(0) D
|
|
. . Q:'$D(LRVSPEC(LRVSPEC)) S LRSP=$E(LRVSPEC(LRVSPEC))
|
|
. . S LRSB=0 F S LRSB=$O(LRSB(LRSP,LRSB)) Q:LRSB<2 I $D(^LR(LRDFN,"CH",LRIDT,LRSB)) S LRVR=^(LRSB) D SET
|
|
. . I $O(LRVV(0)) D FILE
|
|
WRAP K DA,DR,DIC,DIE,DD,DO
|
|
S (X,DINUM)=1
|
|
S DIC="^LAR(64.036,",DIC(0)="LNM" D FILE^DICN S DA=+Y
|
|
G:Y<1 END
|
|
S DR="9///"_DT,DR(2,64.369)=".01///"_DT_";1///"_LRSDT_";2///"_LREDT_";3///"_$$NOW^LRAFUNC1_";4////"_$G(DUZ)
|
|
S DIE=DIC D ^DIE G END
|
|
Q
|
|
SET S LRVV(+LRSB(LRSP,LRSB))=$P(LRVR,U)_U_$P(LRVR,U,2)_U_LRSB(LRSP,LRSB,64)
|
|
Q
|
|
INIT ; ** This section modified by RBN to allow DSS to get all site/samples available from Lab
|
|
K LRVSPEC
|
|
N I,II
|
|
S I="B" F S I=$O(^ECX(727.2,1,I)) Q:I=""!(I>0) D
|
|
. S II=0 F S II=$O(^ECX(727.2,1,I,II)) Q:II<1 D
|
|
. . I $D(^LAB(61,II,0))#2 S LRVSPEC(II)=I_U_$P(^(0),U)
|
|
K LRSP
|
|
TEST ;
|
|
S I=0 F S I=$O(^ECX(727.2,1,1,I)) Q:I<1 I $D(^(I,0)) S LRSP=$P(^(0),U,2) D
|
|
. S II=0 F S II=$O(^ECX(727.2,1,1,I,"LOC",II)) Q:II<1 S LRTS=+$G(^(II,0)) I LRTS D
|
|
. . S LRSB=$P($G(^LAB(60,LRTS,0)),";",2) I LRSB,$G(^(64)) S LRSB(LRSP,LRSB)=I_U_LRTS_U_$P(^(0),U),LRSB(LRSP,LRSB,64)=$P(^(64),U)
|
|
K LRTS Q
|
|
TST Q ;S LRDBUG=1,LRSDT=2970100,LREDT=DT K ^LAR(64.036) G EN
|
|
END L -^LAR(64.036)
|
|
K D,D0,D1,DA,DFN,DI,DIC,DIE,DR,I,II,LRDA,LRDPF,LRIDT,LRN,LRN0
|
|
K LRNOW,LRSB,LRSP,LRTS,LRVR,LRVSPEC,LRVV,LRX1,LRX2,X,DLAYGO
|
|
K LRDFN,D2,LRSP,LRTS,DINUM Q
|
|
FILE K DR,DA,DIC,DIR,LRPROV
|
|
D UID
|
|
S LRN0T1=$P(LRN0,U),LRN0T2=$P(LRN0,U,3),LRPROV=$P(LRN0,U,10)
|
|
S $P(LRN0,U)=$S(LRN0T2<LRN0T1:LRN0T2,1:LRN0T1)
|
|
S X=$P(^LAR(64.036,0),U,3) S:X<2 X=2 F X=X:1 Q:'$D(^LAR(64.036,X))
|
|
S DA=X,DIC="^LAR(64.036,",DINUM=X,DIC(0)="LNMF"
|
|
S LRN0T1=$E($P($P(LRN0,U),".",2),1,4) S:'LRN0T1 LRN0T1=0 I LRN0T1,$E(LRN0T1,3,4)>59 S LRN0T1=$E(LRN0T1,1,2)_"59"
|
|
S LRN0T2=$E($P($P(LRN0,U,3),".",2),1,4) S:'LRN0T2 LRN0T2=0
|
|
S DIC("DR")="1///"_LRDPF_";2///"_DFN_";3///"_$P($P(LRN0,U),".")_";4///"_LRN0T1_";5///"_$P($P(LRN0,U,3),".")_";6///"_LRN0T2_";7///`"_LRVSPEC_";12///`"_LRPROV
|
|
K DD,DO D FILE^DICN K DA S LRDA=Y Q:LRDA<1
|
|
S $P(^LAR(64.036,+LRDA,0),U,9)=LRSPDT,$P(^(0),U,10)=LRSPTM
|
|
F2 F LRTS=0:0 S LRTS=$O(LRVV(LRTS)) Q:LRTS<1 D DR1
|
|
K LRVV,LRN0T1,LRN0T2
|
|
Q
|
|
DR1 K DR,DIC,DIR,DIE S (X,DA)=+LRDA
|
|
S DR="8///"_LRTS
|
|
S DR(2,64.368)=".01///"_LRTS_";1///"_$P(LRVV(LRTS),U)_";2///"_$P(LRVV(LRTS),U,2)_";3///`"_$P(LRVV(LRTS),U,3)
|
|
S DIC="^LAR(64.036,"
|
|
S DIE=DIC,DIC(0)="LNM" D ^DIE
|
|
Q
|
|
FIX S X=$P(^LAR(64.036,0),U,1,2) K ^LAR(64.036) S ^LAR(64.036,0)=X Q
|
|
UID ;
|
|
S LRN0T2=$P(LRN0,U,3)
|
|
S LRSPDT=$P($P(LRN0,U),"."),LRSPTM=$E($P($P(LRN0,U),".",2),1,4)
|
|
D
|
|
. I 'LRSPTM S LRSPTM=1 Q
|
|
. I LRSPTM,$E(LRSPTM,3,4)>59 S LRSPTM=$E(LRSPTM,1,2)_"59"
|
|
S LRN0T1=LRSPDT_"."_LRSPTM,$P(LRN0,U)=LRN0T1
|
|
S UID=$P($G(^LR(LRDFN,"CH",LRIDT,"ORU")),U) Q:'$L(UID)
|
|
S LRC=$Q(^LRO(68,"C",UID)) Q:$QS(LRC,3)'=UID
|
|
S LRAA=$QS(LRC,4),LRAD=$QS(LRC,5),LRAN=$QS(LRC,6)
|
|
D
|
|
. N LR3,LRODT,LROODT,LRSN
|
|
. Q:'$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LR3=^(0)
|
|
. S LRODT=$P(LR3,U,4),LRSN=$P(LR3,U,5)
|
|
. S LROODT=$P($G(^LRO(69,LRODT,1,LRSN,0)),U,5)
|
|
. I $G(LROODT) S $P(LRN0,U)=LROODT
|
|
Q
|