source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCONJAM.m@ 823

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1LRCONJAM ;SLC/CJS,MILW/JMC - JAM CONTROLS ONTO ACCESSION ;2/19/91 10:31 ;
2 ;;5.2;LAB SERVICE;**65**;Sep 27, 1994
3 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
4L D L1 I LREND K D,DA,LREND,LRSS,LRTEST,LRYR Q
5 S LRCN=0 F S LRCN=$O(^LRO(68,LRAA,.5,LRCN)) Q:LRCN<1 S LRINC=0 D L2
6 G L
7L2 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)
8 Q
9SETUP D ORDER Q:LRDFN<1 Q:'LRTCNT
10 L +^LRO(68,LRAA) I $D(^LRO(68,LRAA,1,LRAD,1,LRAN)) L -^LRO(68,LRAA) D FAIL Q
11 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_"^"
12 S ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRDFN_"^62.3^"_$P(LRNT,".")_U_DT_U_LRSN,^(3)=LRNT_"^^"_LRNT_"^^"_LRIDT,^(.1)=LRORD
13 S ^LRO(68,LRAA,1,LRAD,1,"E",LRNT,LRAN)="",^LRO(68,LRAA,1,LRAD,1,"D",LRORD,LRAN)=""
14 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=""
15 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
16 S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)="^68.04PA^"_LRHCT_"^"_LRTCNT
17 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
18 S LRUID=$$LRUID^LRX(LRAA,LRAD,LRAN) D EN^LA7ADL(LRUID) ;Creates UID for controls and check for automatic downloading
19 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
20 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)
21 Q
22L1 S LRAA=$O(^LRO(68,LRAA)) S:LRAA<1 LREND=1 Q:LREND S %DT="E",LRSS=$G(^LRO(68,LRAA,0))
23 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)
24 Q
25LREND S LREND=1 Q
26REQUE S ZTRTN="^LRCONJAM",ZTDTH=$H+1_",1",ZTIO="" D ^%ZTLOAD K ZTRTN,ZTDTH,ZTIO,ZTSK Q
27LRTST 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)_"^"
28 Q
29ORDER 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))
30 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"
31 I $T S %=2 D YN^DICN W:%=0 !,"Not sure?" I %'=1 W !,"OK, try later." Q
32FS S LRNT=$$NOW^LRAFUNC1,LRIDT=9999999-LRNT G FS:$D(^LR(LRDFN,LRSS,LRIDT))
33 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)=""
34 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)
35QSN IF $D(^LRO(69,DT,1,LRSN)) S LRSN=LRSN+1 G QSN
36 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
37 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)=""
38 S LRTCNT=LRTCNT-1 G FAIL:'LRTCNT S ^LRO(69,DT,1,LRSN,2,0)="^69.03PA^"_LRTCNT_"^"_LRTCNT
39 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)=""
40 S ^LRO(69,DT,1,LRSN,4,0)="^69.02PA^1^1"
41 S ^LRO(69,DT,1,LRSN,4,1,0)=LRSPEC
42 Q
43FAIL K ^LRO(69,DT,1,LRSN),^LRO(69,DT,1,"AA",LRDFN,LRSN),^LRO(69,"C",LRORD,DT,LRSN) Q
44LOAD ;from LRLL4
45 S LRSN=-1,LRPHSET=1,LRSS="CH",LRAD=DT,LRDTN=DT,LRINC=0,LRURG="",LRSAMP="",LRSPEC="",LRTCNT=0 D ORDER Q:'LRTCNT D ^LRWLST
46 K LRPHSET Q
47END 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
48 K LRSPCDSC,LRSPEC,LRST,LRSUM,LRTCNT,LRTJ,LRTS,LRTST,LRTT,LRUNQ,LRURG,LRWLC,N,PNM,S5,SSN,X,Y,Z,ZTSK,LRHCT,LRPARAM
49 Q
50T 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
51 S:'$D(LRURG) LRURG="" S LRTS=LRTEST(K) D CAP^LRWLST12
52 Q
Note: See TracBrowser for help on using the repository browser.