LRAPWA ;AVAMC/REG - GETP AP ACCESSION FOR WORKLOAD ;8/3/91 13:01
;;5.2;LAB SERVICE;;Sep 27, 1994
K X,Y,LR("CK") R !!,"Select Accession Number: ",LRAN:DTIME Q:LRAN=""!(LRAN[U) I LRAN'?1N.N W $C(7),!!,"Enter a number." G LRAPWA
W " for ",LRH(0) I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W $C(7),!!,"Accession # ",LRAN," for ",LRH(0)," not in ACCESSION file",!! G LRAPWA
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRLLOC=$P(X,"^",7),LRDFN=+X Q:'$D(^LR(LRDFN,0)) S X=^(0) D ^LRUP
W !,LRP," ID: ",SSN S LRI=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",5),LRA=^LR(LRDFN,LRSS,LRI,0),LRRC=$P(LRA,"^",10)
S DIE="^LR(LRDFN,LRSS,",DA=LRI,DA(1)=LRDFN D CK^LRU Q:$D(LR("CK")) D ^DIE D FRE^LRU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPWA 682 printed Dec 13, 2024@02:08:38 Page 2
LRAPWA ;AVAMC/REG - GETP AP ACCESSION FOR WORKLOAD ;8/3/91 13:01
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 KILL X,Y,LR("CK")
READ !!,"Select Accession Number: ",LRAN:DTIME
if LRAN=""!(LRAN[U)
QUIT
IF LRAN'?1N.N
WRITE $CHAR(7),!!,"Enter a number."
GOTO LRAPWA
+3 WRITE " for ",LRH(0)
IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
WRITE $CHAR(7),!!,"Accession # ",LRAN," for ",LRH(0)," not in ACCESSION file",!!
GOTO LRAPWA
+4 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRLLOC=$PIECE(X,"^",7)
SET LRDFN=+X
if '$DATA(^LR(LRDFN,0))
QUIT
SET X=^(0)
DO ^LRUP
+5 WRITE !,LRP," ID: ",SSN
SET LRI=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",5)
SET LRA=^LR(LRDFN,LRSS,LRI,0)
SET LRRC=$PIECE(LRA,"^",10)
+6 SET DIE="^LR(LRDFN,LRSS,"
SET DA=LRI
SET DA(1)=LRDFN
DO CK^LRU
if $DATA(LR("CK"))
QUIT
DO ^DIE
DO FRE^LRU
+7 QUIT
