- 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
