53 lines
4.3 KiB
Mathematica
53 lines
4.3 KiB
Mathematica
LRCONJAM ;SLC/CJS,MILW/JMC - JAM CONTROLS ONTO ACCESSION ;2/19/91 10:31 ;
|
|
;;5.2;LAB SERVICE;**65**;Sep 27, 1994
|
|
S:$D(ZTQUEUED) ZTREQ="@" S LREND=0,U="^",LRAA=0,LRPARAM="1^"_$P($G(^LAB(69.9,1,0)),U,2,99) D DT^LRX,VIDEO^LRPARAM D L,END Q
|
|
L D L1 I LREND K D,DA,LREND,LRSS,LRTEST,LRYR Q
|
|
S LRCN=0 F S LRCN=$O(^LRO(68,LRAA,.5,LRCN)) Q:LRCN<1 S LRINC=0 D L2
|
|
G L
|
|
L2 S LRAN=0 F S LRAN=$O(^LRO(68,LRAA,.5,LRCN,1,LRAN)) Q:LRAN<1 S LRIFN=+^LRO(68,LRAA,.5,LRCN,1,LRAN,0) D LRTST,SETUP L -^LRO(68,LRAA) L -^LRO(69,DT)
|
|
Q
|
|
SETUP D ORDER Q:LRDFN<1 Q:'LRTCNT
|
|
L +^LRO(68,LRAA) I $D(^LRO(68,LRAA,1,LRAD,1,LRAN)) L -^LRO(68,LRAA) D FAIL Q
|
|
I $D(^LRO(68,LRAA,1,LRAD,0))[0 S ^(0)=LRAD,^(1,0)="^68.02PA^" I $D(^LRO(68,LRAA,1,0))[0 S ^(0)="^68.01DA^"_LRAD_"^"
|
|
S ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRDFN_"^62.3^"_$P(LRNT,".")_U_DT_U_LRSN,^(3)=LRNT_"^^"_LRNT_"^^"_LRIDT,^(.1)=LRORD
|
|
S ^LRO(68,LRAA,1,LRAD,1,"E",LRNT,LRAN)="",^LRO(68,LRAA,1,LRAD,1,"D",LRORD,LRAN)=""
|
|
S ^LRO(68,LRAA,1,LRAD,1,LRAN,.2)=$P(^LRO(68,LRAA,0),U,11)_" "_$S(LRAD["0000":$E(LRAD,2,3),1:$E(LRAD,4,7))_" "_LRAN,LRHCT=""
|
|
F K=1:1:LRTCNT S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST(K),0)=LRTEST(K)_U_LROUTINE,^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",LRTEST(K),LRTEST(K))="" S:LRTEST(K)>LRHCT LRHCT=LRTEST(K) D T
|
|
S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)="^68.04PA^"_LRHCT_"^"_LRTCNT
|
|
S:LRSPEC ^LRO(68,LRAA,1,LRAD,1,LRAN,5,0)="^68.05PA^1^1",^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)=LRSPEC
|
|
S LRUID=$$LRUID^LRX(LRAA,LRAD,LRAN) D EN^LA7ADL(LRUID) ;Creates UID for controls and check for automatic downloading
|
|
IF '$D(^LR(LRDFN,LRSS,0)) S ^LR(LRDFN,LRSS,0)=U_$P(^DD(63,$O(^DD(63,"GL",LRSS,0,0)),0),U,2)_U
|
|
S ^LR(LRDFN,LRSS,0)=$P(^LR(LRDFN,LRSS,0),U,1,2)_U_LRIDT_U_(1+$P(^(0),U,4)),^LR(LRDFN,LRSS,LRIDT,0)=LRNT_"^^^^"_LRSPEC_"^"_^LRO(68,LRAA,1,LRAD,1,LRAN,.2)
|
|
Q
|
|
L1 S LRAA=$O(^LRO(68,LRAA)) S:LRAA<1 LREND=1 Q:LREND S %DT="E",LRSS=$G(^LRO(68,LRAA,0))
|
|
S LRRLOVR=$P(LRSS,U,3),LRSS=$P(LRSS,U,2),LRAD=+$S(LRRLOVR="Y":$E(DT,1,3)_"0000",LRRLOVR="M":$E(DT,1,5)_"00",1:DT)
|
|
Q
|
|
LREND S LREND=1 Q
|
|
REQUE S ZTRTN="^LRCONJAM",ZTDTH=$H+1_",1",ZTIO="" D ^%ZTLOAD K ZTRTN,ZTDTH,ZTIO,ZTSK Q
|
|
LRTST S LRTST="",K=0 F S K=$O(^LAB(62.3,LRIFN,2,K)) Q:K<1 S LRTST=LRTST_+^LAB(62.3,LRIFN,2,K,0)_"^"
|
|
Q
|
|
ORDER S LROUTINE=$P(^LAB(69.9,1,3),U,2),LRDFN=+$S($D(^LAB(62.3,LRIFN,"LR")):^("LR"),1:0),LRDPF=62.3 Q:LRDFN<1 S LRSPEC=$S($L($P(^LAB(62.3,LRIFN,0),U,5)):$P(^(0),U,5),1:$P(^LAB(69.9,1,1),U,5))
|
|
I '$D(ZTQUEUED),$D(^LAB(69.9,1,"RO")),+$H'=^("RO") W $C(7),!,"ROLLOVER ",$S($P(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$C(7),!," Are you sure you want to continue"
|
|
I $T S %=2 D YN^DICN W:%=0 !,"Not sure?" I %'=1 W !,"OK, try later." Q
|
|
FS S LRNT=$$NOW^LRAFUNC1,LRIDT=9999999-LRNT G FS:$D(^LR(LRDFN,LRSS,LRIDT))
|
|
L +^LRO(69,DT) S:'$D(^LRO(69,DT,0)) ^(0)=$P(^LRO(69,0),U,1,2)_U_LRAD_U_(1+$P(^(0),U,4)),^LRO(69,DT,0)=LRAD,^LRO(69,"B",DT,DT)=""
|
|
S LRSN=1+$S($D(^LRO(69,DT,1,0)):$P(^(0),U,3),1:0),LRSUM=1+$S($D(^LRO(69,DT,1,0)):$P(^(0),U,4),1:0)
|
|
QSN IF $D(^LRO(69,DT,1,LRSN)) S LRSN=LRSN+1 G QSN
|
|
S ^LRO(69,DT,1,LRSN,0)=LRDFN_"^^^LC^"_LRNT_"^^^"_LRNT L -^LRO(69,DT) D ORDER^LROW2 S ^LRO(69,DT,1,LRSN,.1)=LRORD,^(1)=LRNT_"^1^^C",^(3)=LRNT
|
|
K LRTEST F LRTCNT=1:1 S LRTT=$P(LRTST,U,LRTCNT) Q:LRTT<1 S LRTEST(LRTCNT)=LRTT,^LRO(69,DT,1,LRSN,2,LRTCNT,0)=LRTT_U_LROUTINE,^LRO(69,DT,1,LRSN,2,"B",LRTT,LRTCNT)=""
|
|
S LRTCNT=LRTCNT-1 G FAIL:'LRTCNT S ^LRO(69,DT,1,LRSN,2,0)="^69.03PA^"_LRTCNT_"^"_LRTCNT
|
|
S DA=LRAD,^LRO(69,DT,1,"AA",LRDFN,LRSN)="",^LRO(69,DT,1,0)="^69.01PA^"_LRSN_U_LRSUM,^LRO(69,"C",LRORD,DT,LRSN)=""
|
|
S ^LRO(69,DT,1,LRSN,4,0)="^69.02PA^1^1"
|
|
S ^LRO(69,DT,1,LRSN,4,1,0)=LRSPEC
|
|
Q
|
|
FAIL K ^LRO(69,DT,1,LRSN),^LRO(69,DT,1,"AA",LRDFN,LRSN),^LRO(69,"C",LRORD,DT,LRSN) Q
|
|
LOAD ;from LRLL4
|
|
S LRSN=-1,LRPHSET=1,LRSS="CH",LRAD=DT,LRDTN=DT,LRINC=0,LRURG="",LRSAMP="",LRSPEC="",LRTCNT=0 D ORDER Q:'LRTCNT D ^LRWLST
|
|
K LRPHSET Q
|
|
END K J,K,LRAA,LRACC,LRAD,LRAN,LRCCOM,LRCDT,LRCN,LRDFN,LRDPF,LRDTN,LREAL,LRGCOM,LRIDT,LRIFN,LRIN,LRINC,LRIOZERO,LRIX,LRLBLBP,LRLLOC,LRNCWL,LRNIDT,LRNT,LROCN,LRODT,LROID,LROLRDFN,LRORD,LROSN,LROUTINE,LRPR,LRPRAC,LRRB,LRRLOVR,LRSAMP,LRSN
|
|
K LRSPCDSC,LRSPEC,LRST,LRSUM,LRTCNT,LRTJ,LRTS,LRTST,LRTT,LRUNQ,LRURG,LRWLC,N,PNM,S5,SSN,X,Y,Z,ZTSK,LRHCT,LRPARAM
|
|
Q
|
|
T I $D(^LRO(69,DT,1,LRSN,2,"B",LRTEST(K))) S X=$O(^(LRTEST(K),0)),$P(^LRO(69,DT,1,LRSN,2,X,0),"^",3,5)=LRAD_"^"_LRAA_"^"_LRAN
|
|
S:'$D(LRURG) LRURG="" S LRTS=LRTEST(K) D CAP^LRWLST12
|
|
Q
|