LRAPED.m

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