- LRPHITE1 ;SLC/CJS-LRPHITEM, CONT ;7/19/88 12:15
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;5.2;LAB SERVICE;**100,121,198,202,208,221**;Sep 27, 1994
- ZAP ;from LRPHITE3
- I '$D(T(LRIX)) W $C(7)," ??" Q
- N LRXNODE
- S LRSN=+T(LRIX),LRITN=$P(T(LRIX),U,2),(LRXNODE,X)=^LRO(69,DT,1,LRSN,2,LRITN,0),LRTST=$P(X,U),LRAD=$P(X,U,3),LRAA=+$P(X,U,4),LRAN=+$P(X,U,5),LRNOP=0,LRACC="??"
- I $P(X,"^",6) W !,LRORD_" has been combined with order # "_$P(X,"^",6) S LRNOP=1 Q
- I '$D(^LRO(68,+$G(LRAA),1,+$G(LRAD),1,+$G(LRAN),0)) G ZAP1
- I $P(^LRO(69,DT,1,LRSN,1),"^",4)="C",$D(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)) W !,LRORD_" has already been collected and is assigned to accession "_^(.2),!,"Do you really want to cancel #"_LRORD S %=2 D YN^DICN I %'=1 S LRNOP=1 Q
- D P16^LRPHITEM Q:LRNOP
- ZAP1 ;
- K T(LRIX)
- I $$VER^LR7OU1<3 S ORIFN=$P(^LRO(69,DT,1,LRSN,2,LRITN,0),U,7) I ORIFN D DC^LRCENDE1
- N I,LRMSTATI,LRCCOM1
- S I(LRTST)=""
- D:'$D(LRNATURE) DC^LROR6(1,1)
- I $L($P($G(LRNATURE),U,5)) S LRCCOM1=$P(LRNATURE,U,5)
- D SINGLE^LRPHITEM
- S LRFLAG=0,J=0 F S J=$O(^LRO(69,DT,1,LRSN,2,J)) Q:J<1 I $P(^(J,0),"^",3) S LRFLAG=1 Q
- S:LRFLAG=0 $P(^LRO(69,DT,1,LRSN,1),"^",4)="U" S:LRFLAG=1 $P(^LRO(69,DT,1,LRSN,1),"^",4)=""
- S $P(^LRO(69,DT,1,LRSN,2,LRITN,0),U,9)="CA",$P(^(0),U,10)="L",$P(^(0),U,11)=DUZ
- D NEW^LR7OB1(LRODT,LRSN,$S($G(LRMSTATI)=""!($G(LRMSTATI)=1):"OC",1:"SC"),$G(LRNATURE),.1,$G(LRMSTATI))
- Q
- COMH ;from LRPHITEM
- S LRFIRST=0 W !,"CAUTION: Entering a comment at the next prompt will automatically CANCEL all",!,"tests for the order numbers previously entered and they will receive a status",!,"of ""NOT COLLECTED""."
- W " The comment will be common to all orders canceled at this",!,"point.",!?10,"If you do not want to cancel the entire order, press carriage"
- W !,"return at the next 3 prompts: 1-'Enter Order Comment:' 2-'OK? YES//'",!,"3-'Enter Order #(s) :'. You must then answer NO to the prompt 'Cancel",!,"entire Order # xxxx? YES//'"
- W " in order to cancel individual items on the",!,"order."
- Q
- END ;from LRPHITEM
- K DIC,LRBATCH,LRLLOC,LRAA,LRAD,LRAN,LRDFN,LRSS,LRITN,LRIDT,LROID,T,LRSN,I,%,A,K,LRCCOM,LREXP,LRFIRST,LRFLAG,LRFORD,LRGCOM,LRNOCOM,LRNT,LRODT,LROR,LRRB,LRSAMP,LRSPEC,LRTSTNM,O,X,Y,Z,%H,%X,%Y,DIWL,DIWR,DO,DPF,J1,LRBED,LRCSN,LRCSS,LRDC
- K LRTEST,LRDTO,LRFLOG,LRIOZERO,LRIX,LRLWC,LRM,LRORDR,LRORDTIM,LROUTINE,LRPR,LRRND,LRSSX,LRSTIK,LRTSN,LRUNQ,LRUR,LRWPC,POP,LROLLOC,LRTREA
- K LRSN0,LRWD,LRCOM,LRCCOMX
- D END^LRCENDEL
- Q
- LRPHITE1 ;SLC/CJS-LRPHITEM, CONT ;7/19/88 12:15
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**100,121,198,202,208,221**;Sep 27, 1994
- ZAP ;from LRPHITE3
- +1 IF '$DATA(T(LRIX))
- WRITE $CHAR(7)," ??"
- QUIT
- +2 NEW LRXNODE
- +3 SET LRSN=+T(LRIX)
- SET LRITN=$PIECE(T(LRIX),U,2)
- SET (LRXNODE,X)=^LRO(69,DT,1,LRSN,2,LRITN,0)
- SET LRTST=$PIECE(X,U)
- SET LRAD=$PIECE(X,U,3)
- SET LRAA=+$PIECE(X,U,4)
- SET LRAN=+$PIECE(X,U,5)
- SET LRNOP=0
- SET LRACC="??"
- +4 IF $PIECE(X,"^",6)
- WRITE !,LRORD_" has been combined with order # "_$PIECE(X,"^",6)
- SET LRNOP=1
- QUIT
- +5 IF '$DATA(^LRO(68,+$GET(LRAA),1,+$GET(LRAD),1,+$GET(LRAN),0))
- GOTO ZAP1
- +6 IF $PIECE(^LRO(69,DT,1,LRSN,1),"^",4)="C"
- IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))
- WRITE !,LRORD_" has already been collected and is assigned to accession "_^(.2),!,"Do you really want to cancel #"_LRORD
- SET %=2
- DO YN^DICN
- IF %'=1
- SET LRNOP=1
- QUIT
- +7 DO P16^LRPHITEM
- IF LRNOP
- QUIT
- ZAP1 ;
- +1 KILL T(LRIX)
- +2 IF $$VER^LR7OU1<3
- SET ORIFN=$PIECE(^LRO(69,DT,1,LRSN,2,LRITN,0),U,7)
- IF ORIFN
- DO DC^LRCENDE1
- +3 NEW I,LRMSTATI,LRCCOM1
- +4 SET I(LRTST)=""
- +5 IF '$DATA(LRNATURE)
- DO DC^LROR6(1,1)
- +6 IF $LENGTH($PIECE($GET(LRNATURE),U,5))
- SET LRCCOM1=$PIECE(LRNATURE,U,5)
- +7 DO SINGLE^LRPHITEM
- +8 SET LRFLAG=0
- SET J=0
- FOR
- SET J=$ORDER(^LRO(69,DT,1,LRSN,2,J))
- IF J<1
- QUIT
- IF $PIECE(^(J,0),"^",3)
- SET LRFLAG=1
- QUIT
- +9 IF LRFLAG=0
- SET $PIECE(^LRO(69,DT,1,LRSN,1),"^",4)="U"
- IF LRFLAG=1
- SET $PIECE(^LRO(69,DT,1,LRSN,1),"^",4)=""
- +10 SET $PIECE(^LRO(69,DT,1,LRSN,2,LRITN,0),U,9)="CA"
- SET $PIECE(^(0),U,10)="L"
- SET $PIECE(^(0),U,11)=DUZ
- +11 DO NEW^LR7OB1(LRODT,LRSN,$SELECT($GET(LRMSTATI)=""!($GET(LRMSTATI)=1):"OC",1:"SC"),$GET(LRNATURE),.1,$GET(LRMSTATI))
- +12 QUIT
- COMH ;from LRPHITEM
- +1 SET LRFIRST=0
- WRITE !,"CAUTION: Entering a comment at the next prompt will automatically CANCEL all",!,"tests for the order numbers previously entered and they will receive a status",!,"of ""NOT COLLECTED""."
- +2 WRITE " The comment will be common to all orders canceled at this",!,"point.",!?10,"If you do not want to cancel the entire order, press carriage"
- +3 WRITE !,"return at the next 3 prompts: 1-'Enter Order Comment:' 2-'OK? YES//'",!,"3-'Enter Order #(s) :'. You must then answer NO to the prompt 'Cancel",!,"entire Order # xxxx? YES//'"
- +4 WRITE " in order to cancel individual items on the",!,"order."
- +5 QUIT
- END ;from LRPHITEM
- +1 KILL DIC,LRBATCH,LRLLOC,LRAA,LRAD,LRAN,LRDFN,LRSS,LRITN,LRIDT,LROID,T,LRSN,I,%,A,K,LRCCOM,LREXP,LRFIRST,LRFLAG,LRFORD,LRGCOM,LRNOCOM,LRNT,LRODT,LROR,LRRB,LRSAMP,LRSPEC,LRTSTNM,O,X,Y,Z,%H,%X,%Y,DIWL,DIWR,DO,DPF,J1,LRBED,LRCSN,LRCSS,LRDC
- +2 KILL LRTEST,LRDTO,LRFLOG,LRIOZERO,LRIX,LRLWC,LRM,LRORDR,LRORDTIM,LROUTINE,LRPR,LRRND,LRSSX,LRSTIK,LRTSN,LRUNQ,LRUR,LRWPC,POP,LROLLOC,LRTREA
- +3 KILL LRSN0,LRWD,LRCOM,LRCCOMX
- +4 DO END^LRCENDEL
- +5 QUIT
