Routine: LRMIEDZ3

LRMIEDZ3 ; IHS/DIR/FJE - MICROBIOLOGY EDIT ROUTINE CONT. 7/21/87 11:01 ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;;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

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."

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)

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)=""

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)=""

LRMIEDZ3  ; IHS/DIR/FJE - MICROBIOLOGY EDIT ROUTINE CONT. 7/21/87 11:01 ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;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

LRMIEDZ3.m