LRMIEDZ3 ;SLC/CJS/BA - MICROBIOLOGY EDIT ROUTINE CONT. ; 7/21/87 11:01 ;

;;5.2;LAB SERVICE;;Sep 27, 1994

TIME ;from LRMIEDZ2

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)

Q

STORE D NOW^%DTC I Y>% 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[HLRMIEDZ3 1691 printed Nov 24, 2022@13:54:12 Page 2

LRMIEDZ3 ;SLC/CJS/BA - MICROBIOLOGY EDIT ROUTINE CONT. ; 7/21/87 11:01 ;

+1 ;;5.2;LAB SERVICE;;Sep 27, 1994

TIME ;from LRMIEDZ2

+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)

+2 QUIT

STORE DO NOW^%DTC

IF Y>%

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