LRAPEDC ;AVAMC/REG,WTY,PMK - EDIT ANATOMIC PATH COMMENTS ;23 Jul 2013 1:53 PM
;;5.2;LAB SERVICE;**72,259,433**;Sep 27, 1994;Build 4
;
N LRREL,LRFLD,LRFILE,LRMSG
S LRDICS="SPCYEM" D ^LRAP Q:'$D(Y)
D XR^LRU
ASK ;
W !?14,"1. Enter/edit specimen comment(s)"
W !?14,"2. Enter/edit delayed report comment(s)"
R !,"CHOOSE (1-2): ",X:DTIME
G:X=""!(X[U) END
I X'=1&(X'=2) D G ASK
.W $C(7),!,"Must select either a '1' or a '2'"
S DR=$S(X=1:.99,1:.97),LR("C")=$S(X=1:"specimen",1:"delayed report")
W !!,"EDIT ",LRO(68)," ",LR("C")," comments 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 W $C(7)," ENTER NUMBERS ONLY" G G
D EDIT
;
I $T(EDIT^MAGT7MA)'="" D EDIT^MAGT7MA ; invoke Imaging HL7 routine - P433
;
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 %=1 D YN^LRU Q:%'=1
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 LRFLD=$S(LRSS="SP":8,LRSS="CY":9,LRSS="EM":2,1:"")
Q:LRFLD=""
S LRFILE=+$$GET1^DID(63,LRFLD,"","SPECIFIER")
S LRREL=+$$GET1^DIQ(LRFILE,LRI_","_LRDFN_",",.11,"I")
I LRREL D Q
.K LRMSG
.S LRMSG=$C(7)_"Report released. Edit not allowed from this option."
.D EN^DDIOL(LRMSG,"","!!")
S X=^LR(LRDFN,LRSS,LRI,0)
I $P($P(X,"^",6)," ")'=LRABV Q
S LRD=$P(X,"^",10),DA=LRI,DA(1)=LRDFN,DIE="^LR(LRDFN,LRSS,"
S (LRB,Y)=+X D D^LRU W !,"Specimen date: ",Y
D ^DIE
Q
END ;
D V^LRU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPEDC 1925 printed Nov 22, 2024@17:17:26 Page 2
LRAPEDC ;AVAMC/REG,WTY,PMK - EDIT ANATOMIC PATH COMMENTS ;23 Jul 2013 1:53 PM
+1 ;;5.2;LAB SERVICE;**72,259,433**;Sep 27, 1994;Build 4
+2 ;
+3 NEW LRREL,LRFLD,LRFILE,LRMSG
+4 SET LRDICS="SPCYEM"
DO ^LRAP
if '$DATA(Y)
QUIT
+5 DO XR^LRU
ASK ;
+1 WRITE !?14,"1. Enter/edit specimen comment(s)"
+2 WRITE !?14,"2. Enter/edit delayed report comment(s)"
+3 READ !,"CHOOSE (1-2): ",X:DTIME
+4 if X=""!(X[U)
GOTO END
+5 IF X'=1&(X'=2)
Begin DoDot:1
+6 WRITE $CHAR(7),!,"Must select either a '1' or a '2'"
End DoDot:1
GOTO ASK
+7 SET DR=$SELECT(X=1:.99,1:.97)
SET LR("C")=$SELECT(X=1:"specimen",1:"delayed report")
+8 WRITE !!,"EDIT ",LRO(68)," ",LR("C")," comments for ",LRH(0)," "
+9 SET %=1
DO YN^LRU
if %<1
GOTO END
+10 IF %=2
Begin DoDot:1
+11 SET %DT="AE"
SET %DT(0)="-N"
SET %DT("A")="Enter YEAR: "
+12 DO ^%DT
KILL %DT
+13 if Y<1
QUIT
+14 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
+15 SET LRC=$EXTRACT(LRAD,1,3)
G ;
+1 WRITE !!,"Enter ",LRO(68)," Accession #: "
+2 READ LRAN:DTIME
if LRAN=""!(LRAN[U)
GOTO END
+3 IF LRAN'?1N.N
WRITE $CHAR(7)," ENTER NUMBERS ONLY"
GOTO G
+4 DO EDIT
+5 ;
+6 ; invoke Imaging HL7 routine - P433
IF $TEXT(EDIT^MAGT7MA)'=""
DO EDIT^MAGT7MA
+7 ;
+8 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 SET X=^LR(LRDFN,0)
DO ^LRUP
+5 WRITE !,LRP," ID: ",SSN," OK "
+6 SET %=1
DO YN^LRU
if %'=1
QUIT
+7 SET LRI=+$ORDER(^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,0))
+8 IF '$DATA(^LR(LRDFN,LRSS,LRI,0))
Begin DoDot:1
+9 WRITE $CHAR(7),!,"Entry in x-ref but not in file ! X-ref deleted."
+10 KILL ^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,LRI)
End DoDot:1
QUIT
+11 SET LRFLD=$SELECT(LRSS="SP":8,LRSS="CY":9,LRSS="EM":2,1:"")
+12 if LRFLD=""
QUIT
+13 SET LRFILE=+$$GET1^DID(63,LRFLD,"","SPECIFIER")
+14 SET LRREL=+$$GET1^DIQ(LRFILE,LRI_","_LRDFN_",",.11,"I")
+15 IF LRREL
Begin DoDot:1
+16 KILL LRMSG
+17 SET LRMSG=$CHAR(7)_"Report released. Edit not allowed from this option."
+18 DO EN^DDIOL(LRMSG,"","!!")
End DoDot:1
QUIT
+19 SET X=^LR(LRDFN,LRSS,LRI,0)
+20 IF $PIECE($PIECE(X,"^",6)," ")'=LRABV
QUIT
+21 SET LRD=$PIECE(X,"^",10)
SET DA=LRI
SET DA(1)=LRDFN
SET DIE="^LR(LRDFN,LRSS,"
+22 SET (LRB,Y)=+X
DO D^LRU
WRITE !,"Specimen date: ",Y
+23 DO ^DIE
+24 QUIT
END ;
+1 DO V^LRU
+2 QUIT
