LRAPED ;AVAMC/REG/WTY - ANATOMIC PATH EDIT LOG-IN ;11/20/01
;;5.2;LAB SERVICE;**1002,1030,1031**;NOV 01, 1997
;
;;VA LR Patch(s):1,31,72,115,259
;
N LRTMP,LRREL,LRCOMP,LRMSG
D ^LRAP Q:'$D(Y)
D XR^LRU
I LRCAPA D @(LRSS_"^LRAPSWK") G:'$D(X) END
W !!,"EDIT ",LRO(68)," (",LRABV,") Log-In/Clinical Hx for ",LRH(0)," "
S %=1 D YN^LRU G:%<1 END
I %=2 D G:Y<1 END
.S %DT="AE",%DT(0)="-N",%DT("A")="Enter YEAR: "
.D ^%DT K %DT
.Q:Y<1
.S LRAD=$E(Y,1,3)_"0000",Y=LRAD D D^LRU S LRH(0)=Y
S LRC=$E(LRAD,1,3)
G ;
W !!,"Enter ",LRO(68)," Accession #: " R LRAN:DTIME
G:LRAN=""!(LRAN[U) END
I LRAN'?1N.N!($E(LRAN)=0) D G G
.W $C(7),!," ENTER NUMBERS ONLY, No leading zero's"
D EDIT
G G
EDIT ;
S LRDFN=$O(^LR(LRXREF,LRC,LRABV,LRAN,0))
I 'LRDFN W $C(7)," Not in file" Q
I '$D(^LR(LRDFN,0)) K ^LR(LRXREF,LRC,LRABV,LRAN,LRDFN) Q
; S X=^LR(LRDFN,0) D ^LRUP W !,LRP," ID: ",SSN," OK "
S X=^LR(LRDFN,0) D ^LRUP W !,LRP," ID: ",HRCN," OK " ; IHS/MSC/MKK - LR*5.2*1031
S %=1 D YN^LRU Q:%'=1
D @($S("CYEMSP"[LRSS:"I",1:"A"))
Q
I ;Non-autopsy sections (SP,CY,EM)
S LRI=+$O(^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,0))
I '$D(^LR(LRDFN,LRSS,LRI,0)) D Q
.W $C(7),!,"Entry in x-ref but not in file ! X-ref deleted."
.K ^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,LRI)
S X=^LR(LRDFN,LRSS,LRI,0),LRRC=$P(X,"^",10)
S DA=LRI,DA(1)=LRDFN,DIE="^LR("_LRDFN_","""_LRSS_""",",(LRB,Y)=+X
D D^LRU W !,"Specimen date: ",Y
I $P(^LR(LRDFN,LRSS,LRI,0),"^",11)!($P(^(0),"^",3)) D Q
.W $C(7),!!,"Report released or completed. Cannot edit Log-in data."
D:LRCAPA C^LRAPSWK
DIE ;
W ! D CK^LRU
I $D(LR("CK")) K LR("CK") Q
D SET,^DIE
I $D(Y) D HELP G DIE
D CK
D:$O(^LR(LRDFN,LRSS,LRI,.1,0))&("SPCYEM"[LRSS)&(LRCAPA) C1^LRAPSWK
Q
SET ;
S (LRJ,LRE,LRF)=""
S DR=".08;S LRE=X;.07;S LRJ=X;S:LRJ LRJ=$P(^VA(200,LRJ,0),U);"
S DR=DR_".011//^S X=LRJ;.012;.013;.014;.015;.016;.1;S LRG=X;.02;.021;"
S DR=DR_".99;S LRF=X"
S:LRSS="SP" DR(2,63.812)=".01"
S:LRSS="CY" DR(2,63.902)=".01;.02"
S:LRSS="EM" DR(2,63.202)=".01"
Q
SET1 ;
S LRJ="",DA=LRDFN,DIE="^LR(",DR="11;S LRRC=X;14.1;S LRLLOC=X;14.5;"
S DR=DR_"14.6;S LRSVC=X;12.1;S LRMD=X;13.5:13.8"
S:%=1 DR=DR_";16:24;26:31;25;31.1:31.4;25.1:25.9"
D D^LRAUAW
S (Y,LRB)=LR(63,12),LRI=9999999-$P(LRB,".")
Q
A ;Autopsy
S LRREL=+$$GET1^DIQ(63,LRDFN_",",14.7,"I")
S LRCOMP=+$$GET1^DIQ(63,LRDFN_",",13,"I")
I LRREL!LRCOMP D Q
.K LRMSG
.S LRMSG=$C(7)_"Report released or completed. Cannot edit Log-in data."
.D EN^DDIOL(LRMSG,"","!!")
W !!,"Edit Weights & Measurements " S %=2 D YN^LRU Q:%<1
S LRRC=$P(^LR(LRDFN,"AU"),U),DA=LRDFN,DIE="^LR("
D SET1,D^LRU
W !!,"Date Died: ",Y
I 'LRB D Q
.W $C(7),"? Must have date died entered in ",LR(63,.02)," File."
AU ;
W ! D ^DIE
I $D(Y) D HELP G AU
D CK1
Q
CK ;
I '$D(^LR(LRDFN,LRSS,LRI)) D K
Q
CK1 ;
Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S X=^(0)
S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) ^(3)=LRB_"^^^^"_LRI
S LRTMP=$P(X,U,1,2)_U_LRRC_U_$P(X,U,4,6)_U_LRLLOC_U_LRMD_U_LRSVC
S LRTMP=LRTMP_U_$P(X,U,10)
S ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRTMP
S LRD=+$P(X,U,3)
K ^LRO(68,LRAA,1,LRAD,1,"E",LRD,LRAN)
S ^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)=""
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,3),^(3)=LRB_U_$P(X,U,2,99)
Q
K ;
Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN)) D K^LRUDEL
L +^LRO(68,LRAA)
K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)
K ^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)
S X=^LRO(68,LRAA,1,LRAD,1,0)
S LRTMP=$P(X,"^",1,2)_"^"_(LRAN-1)_"^"_($P(X,"^",4)-1)
S ^LRO(68,LRAA,1,LRAD,1,0)=LRTMP
L -^LRO(68,LRAA)
F A=1,2,3,4 D
.I $D(^LRO(69.2,LRAA,A,LRAN)) K ^(LRAN) D
..S X(1)=$O(^LRO(69.2,LRAA,A,0)) S:'X(1) X(1)=0
..I $D(^LRO(69.2,LRAA,A,0)) D
...L +^LRO(69.2,LRAA,A)
...S X=^LRO(69.2,LRAA,A,0)
...S LRTMP=$P(X,"^",1,2)_"^"_X(1)_"^"_$S(X(1)=0:X(1),1:($P(X,"^",4)-1))
...S ^LRO(69.2,LRAA,A,0)=LRTMP
...L -^LRO(69.2,LRAA,A)
Q
HELP ;
W $C(7),!!,"Please do not exit EDIT with an ""^""."
W !,"Press RETURN key repeatedly to complete the edit.",!!
Q
END ;
D V^LRU
Q
LRAPED ;AVAMC/REG/WTY - ANATOMIC PATH EDIT LOG-IN ;11/20/01
+1 ;;5.2;LAB SERVICE;**1002,1030,1031**;NOV 01, 1997
+2 ;
+3 ;;VA LR Patch(s):1,31,72,115,259
+4 ;
+5 NEW LRTMP,LRREL,LRCOMP,LRMSG
+6 DO ^LRAP
IF '$DATA(Y)
QUIT
+7 DO XR^LRU
+8 IF LRCAPA
DO @(LRSS_"^LRAPSWK")
IF '$DATA(X)
GOTO END
+9 WRITE !!,"EDIT ",LRO(68)," (",LRABV,") Log-In/Clinical Hx for ",LRH(0)," "
+10 SET %=1
DO YN^LRU
IF %<1
GOTO END
+11 IF %=2
Begin DoDot:1
+12 SET %DT="AE"
SET %DT(0)="-N"
SET %DT("A")="Enter YEAR: "
+13 DO ^%DT
KILL %DT
+14 IF Y<1
QUIT
+15 SET LRAD=$EXTRACT(Y,1,3)_"0000"
SET Y=LRAD
DO D^LRU
SET LRH(0)=Y
End DoDot:1
IF Y<1
GOTO END
+16 SET LRC=$EXTRACT(LRAD,1,3)
G ;
+1 WRITE !!,"Enter ",LRO(68)," Accession #: "
READ LRAN:DTIME
+2 IF LRAN=""!(LRAN[U)
GOTO END
+3 IF LRAN'?1N.N!($EXTRACT(LRAN)=0)
Begin DoDot:1
+4 WRITE $CHAR(7),!," ENTER NUMBERS ONLY, No leading zero's"
End DoDot:1
GOTO G
+5 DO EDIT
+6 GOTO G
EDIT ;
+1 SET LRDFN=$ORDER(^LR(LRXREF,LRC,LRABV,LRAN,0))
+2 IF 'LRDFN
WRITE $CHAR(7)," Not in file"
QUIT
+3 IF '$DATA(^LR(LRDFN,0))
KILL ^LR(LRXREF,LRC,LRABV,LRAN,LRDFN)
QUIT
+4 ; S X=^LR(LRDFN,0) D ^LRUP W !,LRP," ID: ",SSN," OK "
+5 ; IHS/MSC/MKK - LR*5.2*1031
SET X=^LR(LRDFN,0)
DO ^LRUP
WRITE !,LRP," ID: ",HRCN," OK "
+6 SET %=1
DO YN^LRU
IF %'=1
QUIT
+7 DO @($SELECT("CYEMSP"[LRSS:"I",1:"A"))
+8 QUIT
I ;Non-autopsy sections (SP,CY,EM)
+1 SET LRI=+$ORDER(^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,0))
+2 IF '$DATA(^LR(LRDFN,LRSS,LRI,0))
Begin DoDot:1
+3 WRITE $CHAR(7),!,"Entry in x-ref but not in file ! X-ref deleted."
+4 KILL ^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,LRI)
End DoDot:1
QUIT
+5 SET X=^LR(LRDFN,LRSS,LRI,0)
SET LRRC=$PIECE(X,"^",10)
+6 SET DA=LRI
SET DA(1)=LRDFN
SET DIE="^LR("_LRDFN_","""_LRSS_""","
SET (LRB,Y)=+X
+7 DO D^LRU
WRITE !,"Specimen date: ",Y
+8 IF $PIECE(^LR(LRDFN,LRSS,LRI,0),"^",11)!($PIECE(^(0),"^",3))
Begin DoDot:1
+9 WRITE $CHAR(7),!!,"Report released or completed. Cannot edit Log-in data."
End DoDot:1
QUIT
+10 IF LRCAPA
DO C^LRAPSWK
DIE ;
+1 WRITE !
DO CK^LRU
+2 IF $DATA(LR("CK"))
KILL LR("CK")
QUIT
+3 DO SET
DO ^DIE
+4 IF $DATA(Y)
DO HELP
GOTO DIE
+5 DO CK
+6 IF $ORDER(^LR(LRDFN,LRSS,LRI,.1,0))&("SPCYEM"[LRSS)&(LRCAPA)
DO C1^LRAPSWK
+7 QUIT
SET ;
+1 SET (LRJ,LRE,LRF)=""
+2 SET DR=".08;S LRE=X;.07;S LRJ=X;S:LRJ LRJ=$P(^VA(200,LRJ,0),U);"
+3 SET DR=DR_".011//^S X=LRJ;.012;.013;.014;.015;.016;.1;S LRG=X;.02;.021;"
+4 SET DR=DR_".99;S LRF=X"
+5 IF LRSS="SP"
SET DR(2,63.812)=".01"
+6 IF LRSS="CY"
SET DR(2,63.902)=".01;.02"
+7 IF LRSS="EM"
SET DR(2,63.202)=".01"
+8 QUIT
SET1 ;
+1 SET LRJ=""
SET DA=LRDFN
SET DIE="^LR("
SET DR="11;S LRRC=X;14.1;S LRLLOC=X;14.5;"
+2 SET DR=DR_"14.6;S LRSVC=X;12.1;S LRMD=X;13.5:13.8"
+3 IF %=1
SET DR=DR_";16:24;26:31;25;31.1:31.4;25.1:25.9"
+4 DO D^LRAUAW
+5 SET (Y,LRB)=LR(63,12)
SET LRI=9999999-$PIECE(LRB,".")
+6 QUIT
A ;Autopsy
+1 SET LRREL=+$$GET1^DIQ(63,LRDFN_",",14.7,"I")
+2 SET LRCOMP=+$$GET1^DIQ(63,LRDFN_",",13,"I")
+3 IF LRREL!LRCOMP
Begin DoDot:1
+4 KILL LRMSG
+5 SET LRMSG=$CHAR(7)_"Report released or completed. Cannot edit Log-in data."
+6 DO EN^DDIOL(LRMSG,"","!!")
End DoDot:1
QUIT
+7 WRITE !!,"Edit Weights & Measurements "
SET %=2
DO YN^LRU
IF %<1
QUIT
+8 SET LRRC=$PIECE(^LR(LRDFN,"AU"),U)
SET DA=LRDFN
SET DIE="^LR("
+9 DO SET1
DO D^LRU
+10 WRITE !!,"Date Died: ",Y
+11 IF 'LRB
Begin DoDot:1
+12 WRITE $CHAR(7),"? Must have date died entered in ",LR(63,.02)," File."
End DoDot:1
QUIT
AU ;
+1 WRITE !
DO ^DIE
+2 IF $DATA(Y)
DO HELP
GOTO AU
+3 DO CK1
+4 QUIT
CK ;
+1 IF '$DATA(^LR(LRDFN,LRSS,LRI))
DO K
+2 QUIT
CK1 ;
+1 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
QUIT
SET X=^(0)
+2 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
SET ^(3)=LRB_"^^^^"_LRI
+3 SET LRTMP=$PIECE(X,U,1,2)_U_LRRC_U_$PIECE(X,U,4,6)_U_LRLLOC_U_LRMD_U_LRSVC
+4 SET LRTMP=LRTMP_U_$PIECE(X,U,10)
+5 SET ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRTMP
+6 SET LRD=+$PIECE(X,U,3)
+7 KILL ^LRO(68,LRAA,1,LRAD,1,"E",LRD,LRAN)
+8 SET ^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)=""
+9 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,3)
SET ^(3)=LRB_U_$PIECE(X,U,2,99)
+10 QUIT
K ;
+1 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN))
QUIT
DO K^LRUDEL
+2 LOCK +^LRO(68,LRAA)
+3 KILL ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)
+4 KILL ^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)
+5 SET X=^LRO(68,LRAA,1,LRAD,1,0)
+6 SET LRTMP=$PIECE(X,"^",1,2)_"^"_(LRAN-1)_"^"_($PIECE(X,"^",4)-1)
+7 SET ^LRO(68,LRAA,1,LRAD,1,0)=LRTMP
+8 LOCK -^LRO(68,LRAA)
+9 FOR A=1,2,3,4
Begin DoDot:1
+10 IF $DATA(^LRO(69.2,LRAA,A,LRAN))
KILL ^(LRAN)
Begin DoDot:2
+11 SET X(1)=$ORDER(^LRO(69.2,LRAA,A,0))
IF 'X(1)
SET X(1)=0
+12 IF $DATA(^LRO(69.2,LRAA,A,0))
Begin DoDot:3
+13 LOCK +^LRO(69.2,LRAA,A)
+14 SET X=^LRO(69.2,LRAA,A,0)
+15 SET LRTMP=$PIECE(X,"^",1,2)_"^"_X(1)_"^"_$SELECT(X(1)=0:X(1),1:($PIECE(X,"^",4)-1))
+16 SET ^LRO(69.2,LRAA,A,0)=LRTMP
+17 LOCK -^LRO(69.2,LRAA,A)
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
HELP ;
+1 WRITE $CHAR(7),!!,"Please do not exit EDIT with an ""^""."
+2 WRITE !,"Press RETURN key repeatedly to complete the edit.",!!
+3 QUIT
END ;
+1 DO V^LRU
+2 QUIT
