source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRAPEDC.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1LRAPEDC ;AVAMC/REG/WTY - EDIT ANATOMIC PATH COMMENTS ;11/20/01
2 ;;5.2;LAB SERVICE;**72,259**;Sep 27, 1994
3 ;
4 N LRREL,LRFLD,LRFILE,LRMSG
5 S LRDICS="SPCYEM" D ^LRAP Q:'$D(Y)
6 D XR^LRU
7ASK ;
8 W !?14,"1. Enter/edit specimen comment(s)"
9 W !?14,"2. Enter/edit delayed report comment(s)"
10 R !,"CHOOSE (1-2): ",X:DTIME
11 G:X=""!(X[U) END
12 I X'=1&(X'=2) D G ASK
13 .W $C(7),!,"Must select either a '1' or a '2'"
14 S DR=$S(X=1:.99,1:.97),LR("C")=$S(X=1:"specimen",1:"delayed report")
15 W !!,"EDIT ",LRO(68)," ",LR("C")," comments for ",LRH(0)," "
16 S %=1 D YN^LRU G:%<1 END
17 I %=2 D G:Y<1 END
18 .S %DT="AE",%DT(0)="-N",%DT("A")="Enter YEAR: "
19 .D ^%DT K %DT
20 .Q:Y<1
21 .S LRAD=$E(Y,1,3)_"0000",Y=LRAD D D^LRU S LRH(0)=Y
22 S LRC=$E(LRAD,1,3)
23G ;
24 W !!,"Enter ",LRO(68)," Accession #: "
25 R LRAN:DTIME G:LRAN=""!(LRAN[U) END
26 I LRAN'?1N.N W $C(7)," ENTER NUMBERS ONLY" G G
27 D EDIT
28 G G
29EDIT ;
30 S LRDFN=$O(^LR(LRXREF,LRC,LRABV,LRAN,0))
31 I 'LRDFN W $C(7)," Not in file" Q
32 I '$D(^LR(LRDFN,0)) K ^LR(LRXREF,LRC,LRABV,LRAN,LRDFN) Q
33 S X=^LR(LRDFN,0) D ^LRUP
34 W !,LRP," ID: ",SSN," OK "
35 S %=1 D YN^LRU Q:%'=1
36 S LRI=+$O(^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,0))
37 I '$D(^LR(LRDFN,LRSS,LRI,0)) D Q
38 .W $C(7),!,"Entry in x-ref but not in file ! X-ref deleted."
39 .K ^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,LRI)
40 S LRFLD=$S(LRSS="SP":8,LRSS="CY":9,LRSS="EM":2,1:"")
41 Q:LRFLD=""
42 S LRFILE=+$$GET1^DID(63,LRFLD,"","SPECIFIER")
43 S LRREL=+$$GET1^DIQ(LRFILE,LRI_","_LRDFN_",",.11,"I")
44 I LRREL D Q
45 .K LRMSG
46 .S LRMSG=$C(7)_"Report released. Edit not allowed from this option."
47 .D EN^DDIOL(LRMSG,"","!!")
48 S X=^LR(LRDFN,LRSS,LRI,0)
49 I $P($P(X,"^",6)," ")'=LRABV Q
50 S LRD=$P(X,"^",10),DA=LRI,DA(1)=LRDFN,DIE="^LR(LRDFN,LRSS,"
51 S (LRB,Y)=+X D D^LRU W !,"Specimen date: ",Y
52 D ^DIE
53 Q
54END ;
55 D V^LRU
56 Q
Note: See TracBrowser for help on using the repository browser.