- LRAPEDC ;AVAMC/REG/WTY - EDIT ANATOMIC PATH COMMENTS ;11/20/01
- ;;5.2;LAB SERVICE;**1002,1030,1031**;NOV 01, 1997
- ;
- ;;VA LR Patch(s): 72,259
- ;
- 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
- 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 "
- W !,LRP," ID: ",HRCN," OK " ; IHS/MSC/MKK - LR*5.2*1031
- 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
- LRAPEDC ;AVAMC/REG/WTY - EDIT ANATOMIC PATH COMMENTS ;11/20/01
- +1 ;;5.2;LAB SERVICE;**1002,1030,1031**;NOV 01, 1997
- +2 ;
- +3 ;;VA LR Patch(s): 72,259
- +4 ;
- +5 NEW LRREL,LRFLD,LRFILE,LRMSG
- +6 SET LRDICS="SPCYEM"
- DO ^LRAP
- IF '$DATA(Y)
- QUIT
- +7 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 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 ; W !,LRP," ID: ",SSN," OK "
- +6 ; IHS/MSC/MKK - LR*5.2*1031
- WRITE !,LRP," ID: ",HRCN," OK "
- +7 SET %=1
- DO YN^LRU
- IF %'=1
- QUIT
- +8 SET LRI=+$ORDER(^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,0))
- +9 IF '$DATA(^LR(LRDFN,LRSS,LRI,0))
- Begin DoDot:1
- +10 WRITE $CHAR(7),!,"Entry in x-ref but not in file ! X-ref deleted."
- +11 KILL ^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,LRI)
- End DoDot:1
- QUIT
- +12 SET LRFLD=$SELECT(LRSS="SP":8,LRSS="CY":9,LRSS="EM":2,1:"")
- +13 IF LRFLD=""
- QUIT
- +14 SET LRFILE=+$$GET1^DID(63,LRFLD,"","SPECIFIER")
- +15 SET LRREL=+$$GET1^DIQ(LRFILE,LRI_","_LRDFN_",",.11,"I")
- +16 IF LRREL
- Begin DoDot:1
- +17 KILL LRMSG
- +18 SET LRMSG=$CHAR(7)_"Report released. Edit not allowed from this option."
- +19 DO EN^DDIOL(LRMSG,"","!!")
- End DoDot:1
- QUIT
- +20 SET X=^LR(LRDFN,LRSS,LRI,0)
- +21 IF $PIECE($PIECE(X,"^",6)," ")'=LRABV
- QUIT
- +22 SET LRD=$PIECE(X,"^",10)
- SET DA=LRI
- SET DA(1)=LRDFN
- SET DIE="^LR(LRDFN,LRSS,"
- +23 SET (LRB,Y)=+X
- DO D^LRU
- WRITE !,"Specimen date: ",Y
- +24 DO ^DIE
- +25 QUIT
- END ;
- +1 DO V^LRU
- +2 QUIT
