LRUMD2 ;AVAMC/REG - MD SELECTED TESTS/PATIENTS ;2/18/93 12:57 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
W !!,"Remove patients by (N)umber or (P)atient name" R !,"Enter N or P: ",X:DTIME Q:X=""!(X[U) S:X="n" X="N" S:X="p" X="P"
I X'="N"&(X'="P") W !,"Enter 'N' to delete by number or 'P' to delete by patient." G LRUMD2
S LRF=1 D @X Q
N Q:$D(L)'=11 W !!,"Select number to delete patient " W:LRF "(1-",R-1,")" W ": " R X:DTIME Q:X=""!(X[U)
I X<1!(X>(R-1))!(+X'=X) W $C(7),!,"To delete a patient select a number " W:'LRF "within range shown above" W:LRF "from 1 to ",R-1 G N
I '$D(L(X)) W $C(7),!,"Number ",X," was deleted. It is not necessary to enter the same number again." G N
S LRF=0,LRB=L(X) K L(X) D K G N
K S Y=^LRO(69.2,LRAA,7,DUZ,1,LRB,0) W !,$P(Y,"^",2)," SSN:",$P(Y,U,10)," deleted."
S DA(2)=LRAA,DA(1)=DUZ,DA=LRB,DIK="^LRO(69.2,DA(2),7,DA(1),1," D ^DIK K DIC,DIK,DR,DA Q
;
D W ! S ZTRTN="QUE^LRUMD2" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO D L^LRU,S^LRU,H S LR("F")=1
L S P=0 F R=1:1 S P=$O(^LRO(69.2,LRAA,7,DUZ,1,"C",P)) Q:P=""!(LR("Q")) F L=0:0 S L=$O(^LRO(69.2,LRAA,7,DUZ,1,"C",P,L)) Q:'L!(LR("Q")) D:$Y>(IOSL-6)&(R#2=1) H Q:LR("Q") D W
Q
W S P(1)=$E(P,1,28),X=$S($D(^LRO(69.2,LRAA,7,DUZ,1,L,1)):"("_$E(^(1),1,3)_")",1:"") S:X="()" X="" W:R#2=1 !,$J(R,2),")",?5,P(1),?33,X W:R#2=0 ?40,$J(R,2),")",?44,P(1),?74,X Q
D END^LRUTL,END Q
Q
;
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,"Patient list for: ",$P(^VA(200,DUZ,0),U),!,LR("%") Q
EN ;group removal
K L D EN1^LRUMDS Q:'$D(X) F LRB=0:0 S LRB=$O(^LRO(69.2,LRAA,7,DUZ,1,"D",LRA,LRB)) Q:'LRB D K
Q
P Q:'$O(^LRO(69.2,LRAA,7,DUZ,1,0)) K L W ! S DIC="^LRO(69.2,LRAA,7,DUZ,1,",DIC(0)="AEQ",DIC("A")="Select patient to delete: ",DIC("W")="W "" SSN:"",$P(^(0),U,10)",D="C" D IX^DIC K DIC Q:Y<1 S LRB=+Y D K G P
LR ;from LRUMD,LRUMDU
I '$D(^LRO(69.2,LRAA,0)) L +^LRO(69.2) S ^LRO(69.2,LRAA,0)=LRAA_"^"_LRAA(2),X=^LRO(69.2,0),^(0)=$P(X,"^",1,2)_"^"_LRAA_"^"_($P(X,"^",4)+1),^LRO(69.2,"B",LRAA,LRAA)="",^LRO(69.2,"C",LRAA(2),LRAA)="" L -^LRO(69.2)
S:'$D(^LRO(69.2,LRAA,7,0)) ^(0)="^69.28PA^0^0" I '$D(^(DUZ,0)) L +^LRO(69.2,LRAA,7) S ^LRO(69.2,LRAA,7,DUZ,0)=DUZ,X=^LRO(69.2,LRAA,7,0),^(0)=$P(X,"^",1,2)_"^"_DUZ_"^"_($P(X,"^",4)+1) L -^LRO(69.2,LRAA,7)
S ^LRO(69.2,LRAA,7,DUZ,0)=DUZ_"^"_DT S:'$D(^(60,0)) ^(0)="^69.35A^0^0" S:'$D(^LRO(69.2,LRAA,7,DUZ,1,0)) ^(0)="^69.3PA^0^0" Q
;
END D V^LRU Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUMD2 2419 printed Nov 22, 2024@17:31:44 Page 2
LRUMD2 ;AVAMC/REG - MD SELECTED TESTS/PATIENTS ;2/18/93 12:57 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 WRITE !!,"Remove patients by (N)umber or (P)atient name"
READ !,"Enter N or P: ",X:DTIME
if X=""!(X[U)
QUIT
if X="n"
SET X="N"
if X="p"
SET X="P"
+3 IF X'="N"&(X'="P")
WRITE !,"Enter 'N' to delete by number or 'P' to delete by patient."
GOTO LRUMD2
+4 SET LRF=1
DO @X
QUIT
N if $DATA(L)'=11
QUIT
WRITE !!,"Select number to delete patient "
if LRF
WRITE "(1-",R-1,")"
WRITE ": "
READ X:DTIME
if X=""!(X[U)
QUIT
+1 IF X<1!(X>(R-1))!(+X'=X)
WRITE $CHAR(7),!,"To delete a patient select a number "
if 'LRF
WRITE "within range shown above"
if LRF
WRITE "from 1 to ",R-1
GOTO N
+2 IF '$DATA(L(X))
WRITE $CHAR(7),!,"Number ",X," was deleted. It is not necessary to enter the same number again."
GOTO N
+3 SET LRF=0
SET LRB=L(X)
KILL L(X)
DO K
GOTO N
K SET Y=^LRO(69.2,LRAA,7,DUZ,1,LRB,0)
WRITE !,$PIECE(Y,"^",2)," SSN:",$PIECE(Y,U,10)," deleted."
+1 SET DA(2)=LRAA
SET DA(1)=DUZ
SET DA=LRB
SET DIK="^LRO(69.2,DA(2),7,DA(1),1,"
DO ^DIK
KILL DIC,DIK,DR,DA
QUIT
+2 ;
D WRITE !
SET ZTRTN="QUE^LRUMD2"
DO BEG^LRUTL
if POP!($DATA(ZTSK))
GOTO END
QUE USE IO
DO L^LRU
DO S^LRU
DO H
SET LR("F")=1
L SET P=0
FOR R=1:1
SET P=$ORDER(^LRO(69.2,LRAA,7,DUZ,1,"C",P))
if P=""!(LR("Q"))
QUIT
FOR L=0:0
SET L=$ORDER(^LRO(69.2,LRAA,7,DUZ,1,"C",P,L))
if 'L!(LR("Q"))
QUIT
if $Y>(IOSL-6)&(R#2=1)
DO H
if LR("Q")
QUIT
DO W
+1 QUIT
W SET P(1)=$EXTRACT(P,1,28)
SET X=$SELECT($DATA(^LRO(69.2,LRAA,7,DUZ,1,L,1)):"("_$EXTRACT(^(1),1,3)_")",1:"")
if X="()"
SET X=""
if R#2=1
WRITE !,$JUSTIFY(R,2),")",?5,P(1),?33,X
if R#2=0
WRITE ?40,$JUSTIFY(R,2),")",?44,P(1),?74,X
QUIT
+1 DO END^LRUTL
DO END
QUIT
+2 QUIT
+3 ;
H IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
if LR("Q")
QUIT
+1 DO F^LRU
WRITE !,"Patient list for: ",$PIECE(^VA(200,DUZ,0),U),!,LR("%")
QUIT
EN ;group removal
+1 KILL L
DO EN1^LRUMDS
if '$DATA(X)
QUIT
FOR LRB=0:0
SET LRB=$ORDER(^LRO(69.2,LRAA,7,DUZ,1,"D",LRA,LRB))
if 'LRB
QUIT
DO K
+2 QUIT
P if '$ORDER(^LRO(69.2,LRAA,7,DUZ,1,0))
QUIT
KILL L
WRITE !
SET DIC="^LRO(69.2,LRAA,7,DUZ,1,"
SET DIC(0)="AEQ"
SET DIC("A")="Select patient to delete: "
SET DIC("W")="W "" SSN:"",$P(^(0),U,10)"
SET D="C"
DO IX^DIC
KILL DIC
if Y<1
QUIT
SET LRB=+Y
DO K
GOTO P
LR ;from LRUMD,LRUMDU
+1 IF '$DATA(^LRO(69.2,LRAA,0))
LOCK +^LRO(69.2)
SET ^LRO(69.2,LRAA,0)=LRAA_"^"_LRAA(2)
SET X=^LRO(69.2,0)
SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRAA_"^"_($PIECE(X,"^",4)+1)
SET ^LRO(69.2,"B",LRAA,LRAA)=""
SET ^LRO(69.2,"C",LRAA(2),LRAA)=""
LOCK -^LRO(69.2)
+2 if '$DATA(^LRO(69.2,LRAA,7,0))
SET ^(0)="^69.28PA^0^0"
IF '$DATA(^(DUZ,0))
LOCK +^LRO(69.2,LRAA,7)
SET ^LRO(69.2,LRAA,7,DUZ,0)=DUZ
SET X=^LRO(69.2,LRAA,7,0)
SET ^(0)=$PIECE(X,"^",1,2)_"^"_DUZ_"^"_($PIECE(X,"^",4)+1)
LOCK -^LRO(69.2,LRAA,7)
+3 SET ^LRO(69.2,LRAA,7,DUZ,0)=DUZ_"^"_DT
if '$DATA(^(60,0))
SET ^(0)="^69.35A^0^0"
if '$DATA(^LRO(69.2,LRAA,7,DUZ,1,0))
SET ^(0)="^69.3PA^0^0"
QUIT
+4 ;
END DO V^LRU
QUIT
