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