LRCAPAUD ;SLC/FHS - DISPLAY WORKLOAD FOR ACCESSION ;2/13/91 11:05
;;5.2;LAB SERVICE;;Sep 27, 1994
ASK ;
K DX D ^%ZISC S LRALL="" W !!?15,"Which File (68 or 64.1 ) " R TAG:DTIME G:'$T!($E(TAG)="^")!(TAG="") STOP D:$D(TAG) @($S(TAG=68:"A",TAG=64.1:"A2",1:"ERR"))
G ASK
A S %=2 W !?5,"Would like to view verified data from ^LR( also " D YN^DICN Q:%<1 S:%=1 LRVIEW=1
K DIC W !! S DIC="^LRO(68,",DIC(0)="AEQM" D ^DIC G:Y<1 STOP S LRAA=+Y,LRAA(1)=$P(Y,U,2),LRY=$S($D(^LRO(68,LRAA,1,0)):$P(^(0),U,3),1:"")
D W ! S DIC="^LRO(68,LRAA,1,",DIC("B")=LRY,DIC(0)="AEQM",DIC("A")="Select "_LRAA(1)_" Date: " D ^DIC K DIC G:Y<1 A S LRAD=+Y,Y=$P(Y,U,2) D D^LRU S LRD=Y,X1=""
S DIC="^LRO(68,"_LRAA_",1,"_LRAD_",1,"
B R !,"Enter Accession #(s) :",X:DTIME G STOP:'$T!(X=U) I $E(X)="?" W !!,"Enter a string of numbers separated by ',' or '-'",!,"You many enter more than one line of numbers ",! G B
I X'="" S X1=X1_","_X G:X1[U STOP G B
S X=X1 G:'$L(X) STOP
RANGE K X9 D RANGE^LRWU2 I '$L(X9) W !!?10,"NOTHING ENTERED ",$C(7) G STOP
ZIS K IO("Q") S %ZIS="Q" D ^%ZIS G STOP:POP I '$D(IO("Q")) U IO G QUE
S ZTRTN="QUE^LRCAPAUD",ZTIO=ION,ZTDESC="PRINT ACCESSION WORK LOAD" S ZTSAVE("LR*")="" F I="X9","DIC" S ZTSAVE(I)=""
K ZTSK D ^%ZTLOAD W:$G(ZTSK) !!?10,"QUEUED TO "_ION D ^%ZISC K ZTSK G STOP
QUE S:$D(ZTQUEUED) ZTREQ="@" S LRSS=$P($G(^LRO(68,$G(LRAA),0)),U,2)
LOOK G ALL:LRALL K W,DX S X9=X9_"S DA=T1 Q:$D(DTOUT)!($D(DUOUT)) D DIQ^LRCAPAUD"
X X9 G STOP
ALL ;
K DX I 'LRAA F DA=0:0 S DA=$O(@(DIC_DA_")")) Q:'DA!($D(DTOUT))!($D(DUOUT)) D EN^LRDIQ Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
G STOP
DIQ I '$D(@(DIC_T1_",0)")) W !?5,"NO DATA FOR THIS ENTRY "_T1 Q
I LRAA S LRDFN=+^(0),LRIDT=+$P($G(^(3)),U,5) W ! S DR=0 D EN^LRDIQ Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT)) S DR=4 D EN^LRDIQ W !! Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT)) D
. I LRDFN,$D(^LR(LRDFN,LRSS,LRIDT,0)) D LRDIQ
I 'LRAA W ! K DR D EN^LRDIQ Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q
A2 ;Review data in ^LRO(64.1
I '$D(^LRO(64.1)) W !!,$C(7),"Sorry - There is not a ^LRO(64.1) global ",!,$C(7) G STOP
W !! S (LRAA,LRAD)=0,X1=""
K DIC,DA,DR S DIC="^LRO(64.1,",DIC(0)="AQENM" D ^DIC G:Y<1 STOP S LRINST=+Y S DIC="^LRO(64.1,"_LRINST_",1," D ^DIC G:Y<1 STOP S LRDATE=+Y
S DIC="^LRO(64.1,"_LRINST_",1,"_LRDATE_",1,",ZTSAVE("DIC")="",ZTSAVE("LR*")=""
CODE W !?5,"You may select individual codes",!?10,"or enter 'ALL' for complete list",!
S (LRALL,LREND,CODE)="",DIC(0)="EQNM" F R !?10,"ENTER CODE ",X:DTIME S:'$T!($E(X)="^") LREND=1 Q:LREND S:$E(X)="A" LRALL=1 Q:LRALL!(X="") D ^DIC S:Y>0 CODE=CODE_+Y_","
I 'LREND G:LRALL ZIS S:$L(CODE) X=$E(CODE,1,($L(CODE)-1)) G RANGE
STOP W:IOST["P-" @IOF D ^%ZISC K X1,TAG,LRINST,LRDATE,LRVIEW,DTOUT,DUOUT,DR,DIC,T1,DIC,X,LRAA,LRY,LRAD Q
ERR W $C(7),!!,"Select a file or '^' to STOP",!! Q
LRDIQ ;
;Display results from ^LR(
Q:'$G(LRVIEW)
N I,A,N,Z,Y,X,DA,D0,DIC,DIE,DR,DX
S:$D(S) S=S+4 S DA=LRIDT,DA(1)=LRDFN,DIC="^LR("_DA(1)_","""_LRSS_""",",DR="0:999999999999"
W "************ Verified Data ***************"
D EN^LRDIQ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPAUD 3061 printed Sep 23, 2025@19:48:25 Page 2
LRCAPAUD ;SLC/FHS - DISPLAY WORKLOAD FOR ACCESSION ;2/13/91 11:05
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
ASK ;
+1 KILL DX
DO ^%ZISC
SET LRALL=""
WRITE !!?15,"Which File (68 or 64.1 ) "
READ TAG:DTIME
if '$TEST!($EXTRACT(TAG)="^")!(TAG="")
GOTO STOP
if $DATA(TAG)
DO @($SELECT(TAG=68:"A",TAG=64.1:"A2",1:"ERR"))
+2 GOTO ASK
A SET %=2
WRITE !?5,"Would like to view verified data from ^LR( also "
DO YN^DICN
if %<1
QUIT
if %=1
SET LRVIEW=1
+1 KILL DIC
WRITE !!
SET DIC="^LRO(68,"
SET DIC(0)="AEQM"
DO ^DIC
if Y<1
GOTO STOP
SET LRAA=+Y
SET LRAA(1)=$PIECE(Y,U,2)
SET LRY=$SELECT($DATA(^LRO(68,LRAA,1,0)):$PIECE(^(0),U,3),1:"")
D WRITE !
SET DIC="^LRO(68,LRAA,1,"
SET DIC("B")=LRY
SET DIC(0)="AEQM"
SET DIC("A")="Select "_LRAA(1)_" Date: "
DO ^DIC
KILL DIC
if Y<1
GOTO A
SET LRAD=+Y
SET Y=$PIECE(Y,U,2)
DO D^LRU
SET LRD=Y
SET X1=""
+1 SET DIC="^LRO(68,"_LRAA_",1,"_LRAD_",1,"
B READ !,"Enter Accession #(s) :",X:DTIME
if '$TEST!(X=U)
GOTO STOP
IF $EXTRACT(X)="?"
WRITE !!,"Enter a string of numbers separated by ',' or '-'",!,"You many enter more than one line of numbers ",!
GOTO B
+1 IF X'=""
SET X1=X1_","_X
if X1[U
GOTO STOP
GOTO B
+2 SET X=X1
if '$LENGTH(X)
GOTO STOP
RANGE KILL X9
DO RANGE^LRWU2
IF '$LENGTH(X9)
WRITE !!?10,"NOTHING ENTERED ",$CHAR(7)
GOTO STOP
ZIS KILL IO("Q")
SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO STOP
IF '$DATA(IO("Q"))
USE IO
GOTO QUE
+1 SET ZTRTN="QUE^LRCAPAUD"
SET ZTIO=ION
SET ZTDESC="PRINT ACCESSION WORK LOAD"
SET ZTSAVE("LR*")=""
FOR I="X9","DIC"
SET ZTSAVE(I)=""
+2 KILL ZTSK
DO ^%ZTLOAD
if $GET(ZTSK)
WRITE !!?10,"QUEUED TO "_ION
DO ^%ZISC
KILL ZTSK
GOTO STOP
QUE if $DATA(ZTQUEUED)
SET ZTREQ="@"
SET LRSS=$PIECE($GET(^LRO(68,$GET(LRAA),0)),U,2)
LOOK if LRALL
GOTO ALL
KILL W,DX
SET X9=X9_"S DA=T1 Q:$D(DTOUT)!($D(DUOUT)) D DIQ^LRCAPAUD"
+1 XECUTE X9
GOTO STOP
ALL ;
+1 KILL DX
IF 'LRAA
FOR DA=0:0
SET DA=$ORDER(@(DIC_DA_")"))
if 'DA!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
DO EN^LRDIQ
if $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+2 GOTO STOP
DIQ IF '$DATA(@(DIC_T1_",0)"))
WRITE !?5,"NO DATA FOR THIS ENTRY "_T1
QUIT
+1 IF LRAA
SET LRDFN=+^(0)
SET LRIDT=+$PIECE($GET(^(3)),U,5)
WRITE !
SET DR=0
DO EN^LRDIQ
if $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
SET DR=4
DO EN^LRDIQ
WRITE !!
if $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
Begin DoDot:1
+2 IF LRDFN
IF $DATA(^LR(LRDFN,LRSS,LRIDT,0))
DO LRDIQ
End DoDot:1
+3 IF 'LRAA
WRITE !
KILL DR
DO EN^LRDIQ
if $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+4 QUIT
A2 ;Review data in ^LRO(64.1
+1 IF '$DATA(^LRO(64.1))
WRITE !!,$CHAR(7),"Sorry - There is not a ^LRO(64.1) global ",!,$CHAR(7)
GOTO STOP
+2 WRITE !!
SET (LRAA,LRAD)=0
SET X1=""
+3 KILL DIC,DA,DR
SET DIC="^LRO(64.1,"
SET DIC(0)="AQENM"
DO ^DIC
if Y<1
GOTO STOP
SET LRINST=+Y
SET DIC="^LRO(64.1,"_LRINST_",1,"
DO ^DIC
if Y<1
GOTO STOP
SET LRDATE=+Y
+4 SET DIC="^LRO(64.1,"_LRINST_",1,"_LRDATE_",1,"
SET ZTSAVE("DIC")=""
SET ZTSAVE("LR*")=""
CODE WRITE !?5,"You may select individual codes",!?10,"or enter 'ALL' for complete list",!
+1 SET (LRALL,LREND,CODE)=""
SET DIC(0)="EQNM"
FOR
READ !?10,"ENTER CODE ",X:DTIME
if '$TEST!($EXTRACT(X)="^")
SET LREND=1
if LREND
QUIT
if $EXTRACT(X)="A"
SET LRALL=1
if LRALL!(X="")
QUIT
DO ^DIC
if Y>0
SET CODE=CODE_+Y_","
+2 IF 'LREND
if LRALL
GOTO ZIS
if $LENGTH(CODE)
SET X=$EXTRACT(CODE,1,($LENGTH(CODE)-1))
GOTO RANGE
STOP if IOST["P-"
WRITE @IOF
DO ^%ZISC
KILL X1,TAG,LRINST,LRDATE,LRVIEW,DTOUT,DUOUT,DR,DIC,T1,DIC,X,LRAA,LRY,LRAD
QUIT
ERR WRITE $CHAR(7),!!,"Select a file or '^' to STOP",!!
QUIT
LRDIQ ;
+1 ;Display results from ^LR(
+2 if '$GET(LRVIEW)
QUIT
+3 NEW I,A,N,Z,Y,X,DA,D0,DIC,DIE,DR,DX
+4 if $DATA(S)
SET S=S+4
SET DA=LRIDT
SET DA(1)=LRDFN
SET DIC="^LR("_DA(1)_","""_LRSS_""","
SET DR="0:999999999999"
+5 WRITE "************ Verified Data ***************"
+6 DO EN^LRDIQ
