source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPLG1.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1LRAPLG1 ;AVAMC/REG/WTY/KLL - LOG-IN CONT. ;07/30/04
2 ;;5.2;LAB SERVICE;**72,121,248,308**;Sep 27, 1994
3 ;
4 ;Reference to ^%ZOSF("TEST" supported by IA #10096
5 ;Reference to ^VA(200 supported by IA #10060
6 ;Reference to ^%DT supported by IA #10003
7 ;Reference to EN^DDIOL supported by IA #10142
8 ;Reference to ^DIE supported by IA #10018
9 ;Reference to DISP^SROSPLG supported by IA #893
10 ;
11 L +^LRO(68,LRAA,1,LRAD):5 I '$T D Q
12 .S MSG="Someone else is logging in specimens. "
13 .S MSG=MSG_"Please wait and try again."
14 .D EN^DDIOL(MSG,"","!!") K MSG
15 S LRAN=$P(^LRO(68,LRAA,1,LRAD,1,0),"^",3)
16 F X=0:0 S LRAN=LRAN+1 Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
17 I $D(^LR(LRXREF,LRH(2),LRABV,LRAN)) F X=0:0 S LRAN=LRAN+1 Q:'$D(^LR(LRXREF,LRH(2),LRABV,LRAN))
18 W !!,"Assign ",LRO(68)," (",LRABV,") accession #: ",LRAN," " S %=1 D YN^LRU
19 I %<1 L -^LRO(68,LRAA,1,LRAD) G OUT
20 I %=2 D OS G:'$D(LRFND) AU K LRFND L -^LRO(68,LRAA,1,LRAD) G OUT
21 S X=^LRO(68,LRAA,1,LRAD,1,0),X(2)=$P(X,"^",4)+1
22 S ^LRO(68,LRAA,1,LRAD,1,0)=$P(X,"^",1,2)_"^"_LRAN_"^"_X(2)
23 S ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRDFN,X=LRAN
24 L -^LRO(68,LRAA,1,LRAD)
25AU S LRAN=X,LRAC=LRABV_" "_$E(LRAD,2,3)_" "_LRAN I LRSS="AU" D ^LRAUAW Q
26 S DA(1)=LRDFN S:'$D(^LR(LRDFN,LRSS,0)) ^(0)="^"_LRSF_"DA^0^0"
27DT W !,"Date/time Specimen taken: "
28 W $S($E(LRAD,1,3)=$E(DT,1,3):"NOW// ",1:"")
29 R X:DTIME G:X[U!('$T) END
30 S:X=""&($E(LRAD,1,3)=$E(DT,1,3)) X="N"
31 S %DT="ETX",%DT(0)="-N" D ^%DT K %DT
32 G:X["?" DT G:Y=-1 END
33 S LRSD=Y,LRI=9999999-Y
34 L +^LR(LRDFN,LRSS):5 I '$T D Q
35 .S MSG="This record is locked by another user. "
36 .S MSG=MSG_"Please wait and try again."
37 .D EN^DDIOL(MSG,"","!!"),X K MSG
38F I $D(^LR(LRDFN,LRSS,LRI,0)) S LRI=LRI-.00001 G F
39 S ^LR(LRDFN,LRSS,LRI,0)=LRSD
40 S X=^LR(LRDFN,LRSS,0),^(0)=$P(X,"^",1,2)_"^"_LRI_"^"_($P(X,"^",4)+1)
41 L -^LR(LRDFN,LRSS)
42 S LR(.07)=$S($D(SRDOC):SRDOC,1:"") K SRDOC
43 S:LR(.07) LR(.07)=$P($G(^VA(200,LR(.07),0)),"^")
44 S DIC(0)="EQLMF",DLAYGO=63,DA=LRI,DIE="^LR(LRDFN,LRSS,"
45 D @LR("L"),^DIE K DLAYGO
46 I $D(Y)!($D(DTOUT)) D Q
47 .W $C(7),!!,"All Prompts not answered <ENTRY DELETED>"
48 .K ^LR(LRDFN,LRSS,DA)
49 .S X=^LR(LRDFN,LRSS,0),X(1)=$O(^(0))
50 .S ^LR(LRDFN,LRSS,0)=$P(X,"^",1,2)_"^"_X(1)_"^"_($P(X,"^",4)-1)
51 .D X
52 I LRSS="CY",LRCAPA D CK^LRAPCWK
53 I LRSS="SP" S X="SROSPLG" X ^%ZOSF("TEST") I $T D DISP^SROSPLG
54 D ^LRUWLF D:LRSS="CY"&LRCAPA ^LRAPCWK D:"SPEM"[LRSS&LRCAPA ^LRAPSWK D:"SPCYEM"[LRSS ^LRSPGD
55 D OERR^LR7OB63D
56 Q
57X ;from LRAUAW
58 K:"CYEMSP"[LRSS ^LR(LRXREF,LRH(2),LRABV,LRAN)
59 I LRSS="AU",$D(LRRC) D
60 .K ^LR("AAUA",+$E(LRRC,1,3),LRABV,LRAN),^LR("AAU",+LRRC,LRDFN)
61 I $D(LRRC),LRRC>1 K:"CYEMSP"[LRSS ^LR(LRXR,LRRC,LRDFN,LRI)
62 K LRRC
63END ;from LRAUAW, LRAPLG2
64 L +^LRO(68,LRAA,1,LRAD):5 I '$T D Q
65 .S MSG="Someone else is logging in specimens. "
66 .S MSG=MSG_"Please wait and try again."
67 .D EN^DDIOL(MSG,"","!!") K MSG
68 K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)
69 S X=^LRO(68,LRAA,1,LRAD,1,0),X(1)=$O(^(0)),X(2)=$P(X,"^",4)-1
70 S ^LRO(68,LRAA,1,LRAD,1,0)=$P(X,"^",1,2)_"^"_X(1)_"^"_X(2)
71 L -^LRO(68,LRAA,1,LRAD)
72 Q
73OS R !!,"Enter Accession # : ",X:DTIME I X=""!(X[U) S LRFND=1 Q
74 I X'?1N.N!(X<1)!(X>99999) W $C(7),!!,"ENTER A WHOLE NUMBER FROM 1 TO 99999",! G OS
75 I $D(^LRO(68,LRAA,1,LRAD,1,X,0)),$P(^(0),U) D ^LRUTELL G OS
76 S ^LRO(68,LRAA,1,LRAD,1,X,0)=LRDFN I $D(LRXREF),$D(^LR(LRXREF,LRH(2),LRABV,X)) D ^LRAPLG2 S LRFND=1
77 Q
78OUT Q
Note: See TracBrowser for help on using the repository browser.