source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRCONJAM.m@ 636

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