LRPHITE1.m

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