LRAPLG1 ;AVAMC/REG/WTY/KLL - LOG-IN CONT. ;07/30/04
;;5.2;LAB SERVICE;**1002,1003,1018,1031**;NOV 1, 1997
;
;;VA LR Patche(s): 72,121,248,308
;
;Reference to ^%ZOSF("TEST" supported by IA #10096
;Reference to ^VA(200 supported by IA #10060
;Reference to ^%DT supported by IA #10003
;Reference to EN^DDIOL supported by IA #10142
;Reference to ^DIE supported by IA #10018
;Reference to DISP^SROSPLG supported by IA #893
;
L +^LRO(68,LRAA,1,LRAD):5 I '$T D Q
.S MSG="Someone else is logging in specimens. "
.S MSG=MSG_"Please wait and try again."
.D EN^DDIOL(MSG,"","!!") K MSG
S LRAN=$P(^LRO(68,LRAA,1,LRAD,1,0),"^",3)
F X=0:0 S LRAN=LRAN+1 Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
I $D(^LR(LRXREF,LRH(2),LRABV,LRAN)) F X=0:0 S LRAN=LRAN+1 Q:'$D(^LR(LRXREF,LRH(2),LRABV,LRAN))
W !!,"Assign ",LRO(68)," (",LRABV,") accession #: ",LRAN," " S %=1 D YN^LRU
I %<1 L -^LRO(68,LRAA,1,LRAD) G OUT
I %=2 D OS G:'$D(LRFND) AU K LRFND L -^LRO(68,LRAA,1,LRAD) G OUT
S X=^LRO(68,LRAA,1,LRAD,1,0),X(2)=$P(X,"^",4)+1
S ^LRO(68,LRAA,1,LRAD,1,0)=$P(X,"^",1,2)_"^"_LRAN_"^"_X(2)
S ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRDFN,X=LRAN
L -^LRO(68,LRAA,1,LRAD)
AU S LRAN=X,LRAC=LRABV_" "_$E(LRAD,2,3)_" "_LRAN I LRSS="AU" D ^LRAUAW Q
S DA(1)=LRDFN S:'$D(^LR(LRDFN,LRSS,0)) ^(0)="^"_LRSF_"DA^0^0"
DT W !,"Date/time Specimen taken: "
W $S($E(LRAD,1,3)=$E(DT,1,3):"NOW// ",1:"")
R X:DTIME G:X[U!('$T) END
; S:X=""&($E(LRAD,1,3)=$E(DT,1,3)) X="N"
; S %DT="ETX",%DT(0)="-N" D ^%DT K %DT
; G:X["?" DT G:Y=-1 END
;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
S:X=""&($E(LRAD,1,3)=$E(DT,1,3)) X="T" S %DT="ETX",%DT(0)="-NOW" D ^%DT K %DT G:X["?" DT G:Y=-1 END ;IHS/ANMC/CLS
;----- END IHS MODIFICATIONS
S LRSD=Y,LRI=9999999-Y
L +^LR(LRDFN,LRSS):5 I '$T D Q
.S MSG="This record is locked by another user. "
.S MSG=MSG_"Please wait and try again."
.D EN^DDIOL(MSG,"","!!"),X K MSG
F I $D(^LR(LRDFN,LRSS,LRI,0)) S LRI=LRI-.00001 G F
S ^LR(LRDFN,LRSS,LRI,0)=LRSD
S X=^LR(LRDFN,LRSS,0),^(0)=$P(X,"^",1,2)_"^"_LRI_"^"_($P(X,"^",4)+1)
L -^LR(LRDFN,LRSS)
S LR(.07)=$S($D(SRDOC):SRDOC,1:"") K SRDOC
S:LR(.07) LR(.07)=$P($G(^VA(200,LR(.07),0)),"^")
S DIC(0)="EQLMF",DLAYGO=63,DA=LRI,DIE="^LR(LRDFN,LRSS,"
D @LR("L"),^DIE K DLAYGO
I $D(Y)!($D(DTOUT)) D Q
.W $C(7),!!,"All Prompts not answered <ENTRY DELETED>"
.K ^LR(LRDFN,LRSS,DA)
.S X=^LR(LRDFN,LRSS,0),X(1)=$O(^(0))
.S ^LR(LRDFN,LRSS,0)=$P(X,"^",1,2)_"^"_X(1)_"^"_($P(X,"^",4)-1)
.D X
I LRSS="CY",LRCAPA D CK^LRAPCWK
I LRSS="SP" S X="SROSPLG" X ^%ZOSF("TEST") I $T D DISP^SROSPLG
D ^LRUWLF D:LRSS="CY"&LRCAPA ^LRAPCWK D:"SPEM"[LRSS&LRCAPA ^LRAPSWK D:"SPCYEM"[LRSS ^LRSPGD
D OERR^LR7OB63D
Q
X ;from LRAUAW
K:"CYEMSP"[LRSS ^LR(LRXREF,LRH(2),LRABV,LRAN)
I LRSS="AU",$D(LRRC) D
.K ^LR("AAUA",+$E(LRRC,1,3),LRABV,LRAN),^LR("AAU",+LRRC,LRDFN)
I $D(LRRC),LRRC>1 K:"CYEMSP"[LRSS ^LR(LRXR,LRRC,LRDFN,LRI)
K LRRC
END ;from LRAUAW, LRAPLG2
L +^LRO(68,LRAA,1,LRAD):5 I '$T D Q
.S MSG="Someone else is logging in specimens. "
.S MSG=MSG_"Please wait and try again."
.D EN^DDIOL(MSG,"","!!") K MSG
K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)
S X=^LRO(68,LRAA,1,LRAD,1,0),X(1)=$O(^(0)),X(2)=$P(X,"^",4)-1
S ^LRO(68,LRAA,1,LRAD,1,0)=$P(X,"^",1,2)_"^"_X(1)_"^"_X(2)
L -^LRO(68,LRAA,1,LRAD)
Q
OS R !!,"Enter Accession # : ",X:DTIME I X=""!(X[U) S LRFND=1 Q
I X'?1N.N!(X<1)!(X>99999) W $C(7),!!,"ENTER A WHOLE NUMBER FROM 1 TO 99999",! G OS
I $D(^LRO(68,LRAA,1,LRAD,1,X,0)),$P(^(0),U) D ^LRUTELL G OS
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
Q
OUT Q
LRAPLG1 ;AVAMC/REG/WTY/KLL - LOG-IN CONT. ;07/30/04
+1 ;;5.2;LAB SERVICE;**1002,1003,1018,1031**;NOV 1, 1997
+2 ;
+3 ;;VA LR Patche(s): 72,121,248,308
+4 ;
+5 ;Reference to ^%ZOSF("TEST" supported by IA #10096
+6 ;Reference to ^VA(200 supported by IA #10060
+7 ;Reference to ^%DT supported by IA #10003
+8 ;Reference to EN^DDIOL supported by IA #10142
+9 ;Reference to ^DIE supported by IA #10018
+10 ;Reference to DISP^SROSPLG supported by IA #893
+11 ;
+12 LOCK +^LRO(68,LRAA,1,LRAD):5
IF '$TEST
Begin DoDot:1
+13 SET MSG="Someone else is logging in specimens. "
+14 SET MSG=MSG_"Please wait and try again."
+15 DO EN^DDIOL(MSG,"","!!")
KILL MSG
End DoDot:1
QUIT
+16 SET LRAN=$PIECE(^LRO(68,LRAA,1,LRAD,1,0),"^",3)
+17 FOR X=0:0
SET LRAN=LRAN+1
IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
QUIT
+18 IF $DATA(^LR(LRXREF,LRH(2),LRABV,LRAN))
FOR X=0:0
SET LRAN=LRAN+1
IF '$DATA(^LR(LRXREF,LRH(2),LRABV,LRAN))
QUIT
+19 WRITE !!,"Assign ",LRO(68)," (",LRABV,") accession #: ",LRAN," "
SET %=1
DO YN^LRU
+20 IF %<1
LOCK -^LRO(68,LRAA,1,LRAD)
GOTO OUT
+21 IF %=2
DO OS
IF '$DATA(LRFND)
GOTO AU
KILL LRFND
LOCK -^LRO(68,LRAA,1,LRAD)
GOTO OUT
+22 SET X=^LRO(68,LRAA,1,LRAD,1,0)
SET X(2)=$PIECE(X,"^",4)+1
+23 SET ^LRO(68,LRAA,1,LRAD,1,0)=$PIECE(X,"^",1,2)_"^"_LRAN_"^"_X(2)
+24 SET ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRDFN
SET X=LRAN
+25 LOCK -^LRO(68,LRAA,1,LRAD)
AU SET LRAN=X
SET LRAC=LRABV_" "_$EXTRACT(LRAD,2,3)_" "_LRAN
IF LRSS="AU"
DO ^LRAUAW
QUIT
+1 SET DA(1)=LRDFN
IF '$DATA(^LR(LRDFN,LRSS,0))
SET ^(0)="^"_LRSF_"DA^0^0"
DT WRITE !,"Date/time Specimen taken: "
+1 WRITE $SELECT($EXTRACT(LRAD,1,3)=$EXTRACT(DT,1,3):"NOW// ",1:"")
+2 READ X:DTIME
IF X[U!('$TEST)
GOTO END
+3 ; S:X=""&($E(LRAD,1,3)=$E(DT,1,3)) X="N"
+4 ; S %DT="ETX",%DT(0)="-N" D ^%DT K %DT
+5 ; G:X["?" DT G:Y=-1 END
+6 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+7 ;IHS/ANMC/CLS
IF X=""&($EXTRACT(LRAD,1,3)=$EXTRACT(DT,1,3))
SET X="T"
SET %DT="ETX"
SET %DT(0)="-NOW"
DO ^%DT
KILL %DT
IF X["?"
GOTO DT
IF Y=-1
GOTO END
+8 ;----- END IHS MODIFICATIONS
+9 SET LRSD=Y
SET LRI=9999999-Y
+10 LOCK +^LR(LRDFN,LRSS):5
IF '$TEST
Begin DoDot:1
+11 SET MSG="This record is locked by another user. "
+12 SET MSG=MSG_"Please wait and try again."
+13 DO EN^DDIOL(MSG,"","!!")
DO X
KILL MSG
End DoDot:1
QUIT
F IF $DATA(^LR(LRDFN,LRSS,LRI,0))
SET LRI=LRI-.00001
GOTO F
+1 SET ^LR(LRDFN,LRSS,LRI,0)=LRSD
+2 SET X=^LR(LRDFN,LRSS,0)
SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRI_"^"_($PIECE(X,"^",4)+1)
+3 LOCK -^LR(LRDFN,LRSS)
+4 SET LR(.07)=$SELECT($DATA(SRDOC):SRDOC,1:"")
KILL SRDOC
+5 IF LR(.07)
SET LR(.07)=$PIECE($GET(^VA(200,LR(.07),0)),"^")
+6 SET DIC(0)="EQLMF"
SET DLAYGO=63
SET DA=LRI
SET DIE="^LR(LRDFN,LRSS,"
+7 DO @LR("L")
DO ^DIE
KILL DLAYGO
+8 IF $DATA(Y)!($DATA(DTOUT))
Begin DoDot:1
+9 WRITE $CHAR(7),!!,"All Prompts not answered <ENTRY DELETED>"
+10 KILL ^LR(LRDFN,LRSS,DA)
+11 SET X=^LR(LRDFN,LRSS,0)
SET X(1)=$ORDER(^(0))
+12 SET ^LR(LRDFN,LRSS,0)=$PIECE(X,"^",1,2)_"^"_X(1)_"^"_($PIECE(X,"^",4)-1)
+13 DO X
End DoDot:1
QUIT
+14 IF LRSS="CY"
IF LRCAPA
DO CK^LRAPCWK
+15 IF LRSS="SP"
SET X="SROSPLG"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO DISP^SROSPLG
+16 DO ^LRUWLF
IF LRSS="CY"&LRCAPA
DO ^LRAPCWK
IF "SPEM"[LRSS&LRCAPA
DO ^LRAPSWK
IF "SPCYEM"[LRSS
DO ^LRSPGD
+17 DO OERR^LR7OB63D
+18 QUIT
X ;from LRAUAW
+1 IF "CYEMSP"[LRSS
KILL ^LR(LRXREF,LRH(2),LRABV,LRAN)
+2 IF LRSS="AU"
IF $DATA(LRRC)
Begin DoDot:1
+3 KILL ^LR("AAUA",+$EXTRACT(LRRC,1,3),LRABV,LRAN),^LR("AAU",+LRRC,LRDFN)
End DoDot:1
+4 IF $DATA(LRRC)
IF LRRC>1
IF "CYEMSP"[LRSS
KILL ^LR(LRXR,LRRC,LRDFN,LRI)
+5 KILL LRRC
END ;from LRAUAW, LRAPLG2
+1 LOCK +^LRO(68,LRAA,1,LRAD):5
IF '$TEST
Begin DoDot:1
+2 SET MSG="Someone else is logging in specimens. "
+3 SET MSG=MSG_"Please wait and try again."
+4 DO EN^DDIOL(MSG,"","!!")
KILL MSG
End DoDot:1
QUIT
+5 KILL ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)
+6 SET X=^LRO(68,LRAA,1,LRAD,1,0)
SET X(1)=$ORDER(^(0))
SET X(2)=$PIECE(X,"^",4)-1
+7 SET ^LRO(68,LRAA,1,LRAD,1,0)=$PIECE(X,"^",1,2)_"^"_X(1)_"^"_X(2)
+8 LOCK -^LRO(68,LRAA,1,LRAD)
+9 QUIT
OS READ !!,"Enter Accession # : ",X:DTIME
IF X=""!(X[U)
SET LRFND=1
QUIT
+1 IF X'?1N.N!(X<1)!(X>99999)
WRITE $CHAR(7),!!,"ENTER A WHOLE NUMBER FROM 1 TO 99999",!
GOTO OS
+2 IF $DATA(^LRO(68,LRAA,1,LRAD,1,X,0))
IF $PIECE(^(0),U)
DO ^LRUTELL
GOTO OS
+3 SET ^LRO(68,LRAA,1,LRAD,1,X,0)=LRDFN
IF $DATA(LRXREF)
IF $DATA(^LR(LRXREF,LRH(2),LRABV,X))
DO ^LRAPLG2
SET LRFND=1
+4 QUIT
OUT QUIT
