LRMIV3 ;SLC/DLG - MICROBIOLOGY VERIFY AUTO INST ROUTINE CONT. ; 9/9/88 1:03 PM ;
;;5.2;LAB SERVICE;;Sep 27, 1994
TIME ;from LRMIV2
F I=0:0 S %DT="XT",X="N",LREND=0 D:'LRFIFO COMP Q:X=""!(X=U)!(X="@") D ^%DT I X'="?" D:Y>0 STORE Q:Y'<1!('$L(X))
I X'=U D:LRSAME POST
K %DT
Q
COMP S Y=$P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,5) D:Y>0 DD^LRX W !,$P(^LAB(60,LRTS,0),U)," completed: "
W:Y'="" Y," //" R X:DTIME S:X=U LREND=1
Q:X=U!(X="") I X="@" D DEL Q
S %DT="XET" W:X="?" !,"Return represents an incomplete test, date/time represents when completed."
Q
DEL F I=0:0 W !," Sure you want to delete" S %=2 D YN^DICN Q:% W !,"This will set the test back to 'incomplete' status."
I %=1 S Y=+$P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,5),$P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,5)="" K:Y ^LRO(68,LRAA,1,LRAD,1,"AD",$P(Y,"."),+LRAN),^LRO(68,LRAA,1,LRAD,1,"AC",Y,+LRAN),^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_LRTS)
Q
STORE I Y\1>DT W !,$C(7),"Date must not be in the future.",! S Y=-1 Q
S $P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,4,5)=DUZ_U_Y,^LRO(68,LRAA,1,LRAD,1,"AD",$P(Y,"."),+LRAN)="",^LRO(68,LRAA,1,LRAD,1,"AC",Y,+LRAN)=""
Q
POST S LRI=0 F I=0:0 S LRI=$O(LRTS(LRI)) Q:LRI<1 Q:LRTS(LRI)=LRTS
Q:LRI<1 S K=0,J=0 F I=0:0 S J=$O(LRTX(J)) Q:J<1 I J'=LRI,LRTX(J)=LRTX(LRI) S K=1 W !,$P(^LAB(60,+LRTS(J),0),U)
Q:'K
F I=0:0 S Y=$P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,5) Q:'Y W !," Have the same edit template.",!," Are all complete" S %=2 D YN^DICN Q:%
I Y,%=1 F J=0:0 S J=$O(LRTX(J)) Q:J<1 I J'=LRI,LRTX(J)=LRTX(LRI) S:'$P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,+LRTS(J),0),U,5) $P(^(0),U,4,5)=DUZ_U_Y,^LRO(68,LRAA,1,LRAD,1,"AD",$P(Y,"."),+LRAN)="",^LRO(68,LRAA,1,LRAD,1,"AC",Y,+LRAN)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIV3 1735 printed Oct 16, 2024@18:18:30 Page 2
LRMIV3 ;SLC/DLG - MICROBIOLOGY VERIFY AUTO INST ROUTINE CONT. ; 9/9/88 1:03 PM ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
TIME ;from LRMIV2
+1 FOR I=0:0
SET %DT="XT"
SET X="N"
SET LREND=0
if 'LRFIFO
DO COMP
if X=""!(X=U)!(X="@")
QUIT
DO ^%DT
IF X'="?"
if Y>0
DO STORE
if Y'<1!('$LENGTH(X))
QUIT
+2 IF X'=U
if LRSAME
DO POST
+3 KILL %DT
+4 QUIT
COMP SET Y=$PIECE(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,5)
if Y>0
DO DD^LRX
WRITE !,$PIECE(^LAB(60,LRTS,0),U)," completed: "
+1 if Y'=""
WRITE Y," //"
READ X:DTIME
if X=U
SET LREND=1
+2 if X=U!(X="")
QUIT
IF X="@"
DO DEL
QUIT
+3 SET %DT="XET"
if X="?"
WRITE !,"Return represents an incomplete test, date/time represents when completed."
+4 QUIT
DEL FOR I=0:0
WRITE !," Sure you want to delete"
SET %=2
DO YN^DICN
if %
QUIT
WRITE !,"This will set the test back to 'incomplete' status."
+1 IF %=1
SET Y=+$PIECE(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,5)
SET $PIECE(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,5)=""
if Y
KILL ^LRO(68,LRAA,1,LRAD,1,"AD",$PIECE(Y,"."),+LRAN),^LRO(68,LRAA,1,LRAD,1,"AC",Y,+LRAN),^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_LRTS)
+2 QUIT
STORE IF Y\1>DT
WRITE !,$CHAR(7),"Date must not be in the future.",!
SET Y=-1
QUIT
+1 SET $PIECE(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,4,5)=DUZ_U_Y
SET ^LRO(68,LRAA,1,LRAD,1,"AD",$PIECE(Y,"."),+LRAN)=""
SET ^LRO(68,LRAA,1,LRAD,1,"AC",Y,+LRAN)=""
+2 QUIT
POST SET LRI=0
FOR I=0:0
SET LRI=$ORDER(LRTS(LRI))
if LRI<1
QUIT
if LRTS(LRI)=LRTS
QUIT
+1 if LRI<1
QUIT
SET K=0
SET J=0
FOR I=0:0
SET J=$ORDER(LRTX(J))
if J<1
QUIT
IF J'=LRI
IF LRTX(J)=LRTX(LRI)
SET K=1
WRITE !,$PIECE(^LAB(60,+LRTS(J),0),U)
+2 if 'K
QUIT
+3 FOR I=0:0
SET Y=$PIECE(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,5)
if 'Y
QUIT
WRITE !," Have the same edit template.",!," Are all complete"
SET %=2
DO YN^DICN
if %
QUIT
+4 IF Y
IF %=1
FOR J=0:0
SET J=$ORDER(LRTX(J))
if J<1
QUIT
IF J'=LRI
IF LRTX(J)=LRTX(LRI)
if '$PIECE(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,+LRTS(J),0),U,5)
SET $PIECE(^(0),U,4,5)=DUZ_U_Y
SET ^LRO(68,LRAA,1,LRAD,1,"AD",$PIECE(Y,"."),+LRAN)=""
SET ^LRO(68,LRAA,1,LRAD,1,"AC",Y,+LRAN)=""
+5 QUIT
