LROW2RP.m

LROW2RP ;SLC/RWA - OPTION TO REPRINT A ORDER ;8/11/97 [ 04/14/2003  11:58 AM ]

 ;;5.2T9;LR;**1003,1006,1018**;Nov 17, 2004

 ;;5.2;LAB SERVICE;**121,201,242**;Sep 27, 1994

 K %ZIS S IOP=0 D ^%ZIS K IOP S DTIME=$S($D(DTIME):DTIME,1:300) I $D(DT)#2+1 S X="T" D ^%DT

 S DIC="^DPT(",DIC(0)="QAEMZ" D ^DIC G:Y<1 Q S DFN=+Y,DFN(0)=$P(Y(0),"^")

 S LRDFN=$$LRDFN^LR7OR1(DFN)

 I 'LRDFN W !!,$P(Y(0),"^")," has no lab data!" G Q

DATE K %DT S %DT="AE",%DT("A")="Date of order: ",%DT("B")="TODAY" D ^%DT G Q:Y<1 S (Y,LRODT)=Y\1

 D D^DIQ S LRODT(0)=Y I '$D(^LRO(69,LRODT,1,"AA",LRDFN)) W !!,DFN(0)," has no collect orders for ",LRODT(0) G Q

 K L S I=0 F  S I=$O(^LRO(69,LRODT,1,"AA",LRDFN,I)) Q:I<1  I $D(^LRO(69,LRODT,1,I,.1)) S X=+^(.1) D K:X

 I '$D(L) W !!,DFN(0)," has no collect orders for ",LRODT(0) G Q

 S Y=$O(L(0)),X=$O(L(Y)) I X W !!?6,"Choose from the following order numbers:",!! S X=0 X "S I=0 F  S I=$O(L(I)) Q:I<1  W:X>6 ! S:X>6 X=0 W ?(X*10+4),$J(I,7) S X=X+1" W !

A W !,"ENTER COLLECT ORDER No.: ",Y,"// " R X:DTIME G Q:'$T!(X["^") S:X="" X=Y G:+X\1'=X!'$D(L(X)) A

 S I=0 F  S I=$O(L(X,I)) Q:I<1  S LRSN(I)=I

IO W !! K %ZIS S %ZIS="N",IOP="P" D ^%ZIS K %ZIS,IOP S:'POP LRORDER=ION I POP S %ZIS="NQ",%ZIS("A")="ORDER COPY DEVICE:" D ^%ZIS S:'POP LRORDER=ION I POP S IOP="HOME" D ^%ZIS

 Q:'$D(LRORDER)  S ION=LRORDER S LRSN=0 F I=0:0 S LRSN=$O(LRSN(LRSN)) G:'LRSN Q D PR

PR ;Send out for printing

 I IO(0)=IO S IOP=LRORDER,%ZIS="" D ^%ZIS D ENT2^LROW2P H 3

 I IO'=IO(0) D ^LROW2P

 Q

Q ;K %DT,%ZIS,I,J,L,X,Y,DFN,DIC,LRBED,LRCS,LRCSS,LRDFN,LRDPF,LRDTO,LRLLOC,LRLWC,LRORDER,LRORDTIM,LRODT,LRPR,LRSN,LRTP,LRUR,LRUSI,LRUSNM,SSN,PNM,T,IO("Q") S IOP=0 D:'$D(ZTQUEUED) ^%ZISC K IOP,ZTSK,VA("BID"),VA("PID") Q

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 K %DT,%ZIS,I,J,L,X,Y,DFN,DIC,LRBED,LRCS,LRCSS,LRDFN,LRDPF,LRDTO,LRLLOC,LRLWC,LRORDER,LRORDTIM,LRODT,LRPR,LRSN,LRTP,LRUR,LRUSI,LRUSNM,SSN,HRCN,PNM,T,IO("Q") S IOP=0 D:'$D(ZTQUEUED) ^%ZISC K IOP,ZTSK,VA("BID"),VA("PID") Q  ;IHS/ANMC/CLS 08/18/96

 ;----- END IHS MODIFICATIONS

K I '$D(^LRO(69,LRODT,1,I,2,0)) S X=""

 I X,'$$GOT^LROE(X,LRODT) S X=""

 S:X]"" L(X,I)="" Q

LROW2RP   ;SLC/RWA - OPTION TO REPRINT A ORDER ;8/11/97 [ 04/14/2003  11:58 AM ]

 +1       ;;5.2T9;LR;**1003,1006,1018**;Nov 17, 2004

 +2       ;;5.2;LAB SERVICE;**121,201,242**;Sep 27, 1994

 +3        KILL %ZIS

           SET IOP=0

           DO ^%ZIS

           KILL IOP

           SET DTIME=$SELECT($DATA(DTIME):DTIME,1:300)

           IF $DATA(DT)#2+1

               SET X="T"

               DO ^%DT

 +4        SET DIC="^DPT("

           SET DIC(0)="QAEMZ"

           DO ^DIC

           IF Y<1

               GOTO Q

           SET DFN=+Y

           SET DFN(0)=$PIECE(Y(0),"^")

 +5        SET LRDFN=$$LRDFN^LR7OR1(DFN)

 +6        IF 'LRDFN

               WRITE !!,$PIECE(Y(0),"^")," has no lab data!"

               GOTO Q

DATE       KILL %DT

           SET %DT="AE"

           SET %DT("A")="Date of order: "

           SET %DT("B")="TODAY"

           DO ^%DT

           IF Y<1

               GOTO Q

           SET (Y,LRODT)=Y\1

 +1        DO D^DIQ

           SET LRODT(0)=Y

           IF '$DATA(^LRO(69,LRODT,1,"AA",LRDFN))

               WRITE !!,DFN(0)," has no collect orders for ",LRODT(0)

               GOTO Q

 +2        KILL L

           SET I=0

           FOR 

               SET I=$ORDER(^LRO(69,LRODT,1,"AA",LRDFN,I))

               IF I<1

                   QUIT 

               IF $DATA(^LRO(69,LRODT,1,I,.1))

                   SET X=+^(.1)

                   IF X

                       DO K

 +3        IF '$DATA(L)

               WRITE !!,DFN(0)," has no collect orders for ",LRODT(0)

               GOTO Q

 +4        SET Y=$ORDER(L(0))

           SET X=$ORDER(L(Y))

           IF X

               WRITE !!?6,"Choose from the following order numbers:",!!

               SET X=0

               XECUTE "S I=0 F  S I=$O(L(I)) Q:I<1  W:X>6 ! S:X>6 X=0 W ?(X*10+4),$J(I,7) S X=X+1"

               WRITE !

A          WRITE !,"ENTER COLLECT ORDER No.: ",Y,"// "

           READ X:DTIME

           IF '$TEST!(X["^")

               GOTO Q

           IF X=""

               SET X=Y

           IF +X\1'=X!'$DATA(L(X))

               GOTO A

 +1        SET I=0

           FOR 

               SET I=$ORDER(L(X,I))

               IF I<1

                   QUIT 

               SET LRSN(I)=I

IO         WRITE !!

           KILL %ZIS

           SET %ZIS="N"

           SET IOP="P"

           DO ^%ZIS

           KILL %ZIS,IOP

           IF 'POP

               SET LRORDER=ION

           IF POP

               SET %ZIS="NQ"

               SET %ZIS("A")="ORDER COPY DEVICE:"

               DO ^%ZIS

               IF 'POP

                   SET LRORDER=ION

               IF POP

                   SET IOP="HOME"

                   DO ^%ZIS

 +1        IF '$DATA(LRORDER)

               QUIT 

           SET ION=LRORDER

           SET LRSN=0

           FOR I=0:0

               SET LRSN=$ORDER(LRSN(LRSN))

               IF 'LRSN

                   GOTO Q

               DO PR

PR        ;Send out for printing

 +1        IF IO(0)=IO

               SET IOP=LRORDER

               SET %ZIS=""

               DO ^%ZIS

               DO ENT2^LROW2P

               HANG 3

 +2        IF IO'=IO(0)

               DO ^LROW2P

 +3        QUIT 

Q         ;K %DT,%ZIS,I,J,L,X,Y,DFN,DIC,LRBED,LRCS,LRCSS,LRDFN,LRDPF,LRDTO,LRLLOC,LRLWC,LRORDER,LRORDTIM,LRODT,LRPR,LRSN,LRTP,LRUR,LRUSI,LRUSNM,SSN,PNM,T,IO("Q") S IOP=0 D:'$D(ZTQUEUED) ^%ZISC K IOP,ZTSK,VA("BID"),VA("PID") Q

 +1       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +2       ;IHS/ANMC/CLS 08/18/96

           KILL %DT,%ZIS,I,J,L,X,Y,DFN,DIC,LRBED,LRCS,LRCSS,LRDFN,LRDPF,LRDTO,LRLLOC,LRLWC,LRORDER,LRORDTIM,LRODT,LRPR,LRSN,LRTP,LRUR,LRUSI,LRUSNM,SSN,HRCN,PNM,T,IO("Q")

           SET IOP=0

           IF '$DATA(ZTQUEUED)

               DO ^%ZISC

           KILL IOP,ZTSK,VA("BID"),VA("PID")

           QUIT 

 +3       ;----- END IHS MODIFICATIONS

K          IF '$DATA(^LRO(69,LRODT,1,I,2,0))

               SET X=""

 +1        IF X

               IF '$$GOT^LROE(X,LRODT)

                   SET X=""

 +2        IF X]""

               SET L(X,I)=""

           QUIT