LRHYPH2 ;DALOI/HOAK - HOWDY ORDER NUMBER SELECTION ;12/10/10 6:00pm
;;5.2;LAB SERVICE;**405,444,450,491**;Sep 27, 1994;Build 2
;
; Reference to ^ORCSAVE2 supported by DBIA #2747.
;
;
Q15 ;
;
I $G(LRBUTZ) K LRBUTZ G BUT
Q:$D(LRSTOPZ(LRORD))
;
BUT ;
I $D(^TMP("LRHYDY",$J,"KILL",LRODT,LRSN,1)) S LRSTOPZ(LRORD)="" D LOG^LRHY0 QUIT
;
Q:'$D(^LRO(69,LRODT,1,LRSN,0))
I M9>1 D LRSPEC^LROE1 S S1=$S($D(^LAB(61,+LRSPEC,0)):$P(^(0),U),1:"") D
. S S2=$P(^LAB(62,LRSAMP,0),U),S4=$P(^(0),U,3)
. S S3=S1_$S(S1'=S2:" "_S2,1:"")
. K S1,S2,S3,S4 S %=2
S DA=DT,LRDFN=+^LRO(69,LRODT,1,LRSN,0),LRDPF=+$P(^LR(LRDFN,0),U,2)
; MODIFIED FOR VERSION 8 10/31
I $D(LRSND),$P(^LRO(69,LRODT,1,LRSN,0),U,4)="LC",$D(^(1)) S LRLLOC=$P(^(0),U,7),LROLLOC=$P(^(0),U,9),LRNT=$S($D(LRNT):LRNT,$D(LRTIM):LRTIM,$D(LRCDT):+LRCDT,1:"") D P15^LRPHITEM G PH
I $D(LRSND) N LRHYCOMB S LRHYCOMB=$P($G(^LRO(69,LRODT,1,LRSN,1)),U,7) D
. S DIE="^LRO(69,"_LRODT_",1,",DA(1)=LRODT,DA=LRSN,DR="10////"_LRTIM D ^DIE
. S DIE="^LRO(69,"_LRODT_",1,",DA(1)=LRODT,DA=LRSN,DR="12////"_DUZ D ^DIE
. S DIE="^LRO(69,"_LRODT_",1,",DA(1)=LRODT,DA=LRSN,DR="13////"_LRSTATUS D ^DIE
. S DIE="^LRO(69,"_LRODT_",1,",DA(1)=LRODT,DA=LRSN,DR="25////"_DUZ(2) D ^DIE
PH G Q16:LRORD D ORDER^LROW2 G Q16A
Q16 S J=0 D CHECK^LROW2 I J D BAD^LROW2
Q16A I $D(LRLONG),$D(LRSND) S LRSN=LRSND,^TMP("LRHYDY",$J,"LROE",$J,"LRORD")=LRORD_U_LRODT_U_LRTIM_U_PNM_U_SSN
K DR S LRTSTS=0
S LRSN=0 F S LRSN=$O(LRSN(LRSN)) Q:'LRSN D Q17
I $D(LRLONG),$D(LRSND) S LRSN=LRSND D LROE^LRFAST S X=^TMP("LRHYDY",$J,"LROE",$J,"LRORD"),LRORD=+X,LRODT=$P(X,"^",2),LRTIM=$P(X,"^",3),LRLONG="",PNM=$P(X,"^",4),SSN=$P(X,"^",5)
Q
Q17 ;
I $D(LRHYCS33(LRODT,LRSN)) I $D(^LRHY(69.86,LRHYSITE,4,"B",LRHYCS33(LRODT,LRSN))) K LRHYCS33(LRODT,LRSN) QUIT
S LRHYDJOB=$O(^TMP("LRHYDY",0))
S I=$O(^LRO(69,LRODT,1,LRSN,6,0)),J=$O(^(1)) S:'$D(IOM) IOM=80 K LRSPCDSC S:J LRSPCDSC=^(J,0) S:I DA=LRSN,DA(1)=LRODT,DR=6,DIC="^LRO(69,"_LRODT_",1," D EN^DIQ:I D LRSPEC^LROE1
;
Q:$D(^TMP("LRHYDY",$J,"KILL",LRODT,LRSN))
S LRLABLIO=LRDEV S ZTIO=LRDEV
D ^LRHYBL1
I $G(LRLABSTP)'="" S LRLABLIO=$P(^%ZIS(1,LRDEV,0),U)_";"_LRLABSTP
; get around comments on Howdy screen
Q:$D(^TMP("LRHYDY",$J,"KILL",LRODT,LRSN))
S DTIME=.5
;
S LRQUIET=1
Q:$D(LROLT1(LRODT,LRSN))
K LRCCOM,X,LRCCOMX,LRCCOM0
; The call to OLD^LRORDST hands off the accessioning process and
; updating of lab files
;
S LR33ORD=LRORD
;K LRORD
D OLD^LRORDST
S LRORD=LR33ORD
I $G(LRUID)'="" D NOW^%DTC S ^TMP("LRHYHOW1",$J,LRUID)=%_U_DUZ
S DTIME=$$DTIME^XUP(DUZ)
D D1^LRHYU
;
S ^LRO(69,"AA",+$G(^LRO(69,LRODT,1,LRSN,.1)),LRODT_"|"_LRSN)=""
;
; Lines below commented out by LR*5.2*491 because:
; (1) Orders have been marked active or discontinued in file
; 100 before this code is called.
; (2) Discontinued orders are being marked active in CPRS if
; LRORIEN is the File 100 ien of the discontinued test order.
; (3) If the lines below are needed, LRORIEN would need to be
; be retrieved from the test level of file 69.
;
;S LRORIEN=$P($G(^LRO(69,LRODT,1,LRSN,0)),U,11)
;I $G(LRORIEN) D
;. D STATUS^ORCSAVE2(LRORIEN,6)
Q:$G(LRNOTEST) D
. K DA,DR S DIE="^LRO(69,"_LRODT_",1,",DA(1)=LRODT,DA=LRSN,DR="12////"_DUZ D ^DIE
. K DA,DR S DIE="^LRO(69,"_LRODT_",1,",DA(1)=LRODT,DA=LRSN,DR="13////C" D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHYPH2 3412 printed Oct 16, 2024@18:16:09 Page 2
LRHYPH2 ;DALOI/HOAK - HOWDY ORDER NUMBER SELECTION ;12/10/10 6:00pm
+1 ;;5.2;LAB SERVICE;**405,444,450,491**;Sep 27, 1994;Build 2
+2 ;
+3 ; Reference to ^ORCSAVE2 supported by DBIA #2747.
+4 ;
+5 ;
Q15 ;
+1 ;
+2 IF $GET(LRBUTZ)
KILL LRBUTZ
GOTO BUT
+3 if $DATA(LRSTOPZ(LRORD))
QUIT
+4 ;
BUT ;
+1 IF $DATA(^TMP("LRHYDY",$JOB,"KILL",LRODT,LRSN,1))
SET LRSTOPZ(LRORD)=""
DO LOG^LRHY0
QUIT
+2 ;
+3 if '$DATA(^LRO(69,LRODT,1,LRSN,0))
QUIT
+4 IF M9>1
DO LRSPEC^LROE1
SET S1=$SELECT($DATA(^LAB(61,+LRSPEC,0)):$PIECE(^(0),U),1:"")
Begin DoDot:1
+5 SET S2=$PIECE(^LAB(62,LRSAMP,0),U)
SET S4=$PIECE(^(0),U,3)
+6 SET S3=S1_$SELECT(S1'=S2:" "_S2,1:"")
+7 KILL S1,S2,S3,S4
SET %=2
End DoDot:1
+8 SET DA=DT
SET LRDFN=+^LRO(69,LRODT,1,LRSN,0)
SET LRDPF=+$PIECE(^LR(LRDFN,0),U,2)
+9 ; MODIFIED FOR VERSION 8 10/31
+10 IF $DATA(LRSND)
IF $PIECE(^LRO(69,LRODT,1,LRSN,0),U,4)="LC"
IF $DATA(^(1))
SET LRLLOC=$PIECE(^(0),U,7)
SET LROLLOC=$PIECE(^(0),U,9)
SET LRNT=$SELECT($DATA(LRNT):LRNT,$DATA(LRTIM):LRTIM,$DATA(LRCDT):+LRCDT,1:"")
DO P15^LRPHITEM
GOTO PH
+11 IF $DATA(LRSND)
NEW LRHYCOMB
SET LRHYCOMB=$PIECE($GET(^LRO(69,LRODT,1,LRSN,1)),U,7)
Begin DoDot:1
+12 SET DIE="^LRO(69,"_LRODT_",1,"
SET DA(1)=LRODT
SET DA=LRSN
SET DR="10////"_LRTIM
DO ^DIE
+13 SET DIE="^LRO(69,"_LRODT_",1,"
SET DA(1)=LRODT
SET DA=LRSN
SET DR="12////"_DUZ
DO ^DIE
+14 SET DIE="^LRO(69,"_LRODT_",1,"
SET DA(1)=LRODT
SET DA=LRSN
SET DR="13////"_LRSTATUS
DO ^DIE
+15 SET DIE="^LRO(69,"_LRODT_",1,"
SET DA(1)=LRODT
SET DA=LRSN
SET DR="25////"_DUZ(2)
DO ^DIE
End DoDot:1
PH if LRORD
GOTO Q16
DO ORDER^LROW2
GOTO Q16A
Q16 SET J=0
DO CHECK^LROW2
IF J
DO BAD^LROW2
Q16A IF $DATA(LRLONG)
IF $DATA(LRSND)
SET LRSN=LRSND
SET ^TMP("LRHYDY",$JOB,"LROE",$JOB,"LRORD")=LRORD_U_LRODT_U_LRTIM_U_PNM_U_SSN
+1 KILL DR
SET LRTSTS=0
+2 SET LRSN=0
FOR
SET LRSN=$ORDER(LRSN(LRSN))
if 'LRSN
QUIT
DO Q17
+3 IF $DATA(LRLONG)
IF $DATA(LRSND)
SET LRSN=LRSND
DO LROE^LRFAST
SET X=^TMP("LRHYDY",$JOB,"LROE",$JOB,"LRORD")
SET LRORD=+X
SET LRODT=$PIECE(X,"^",2)
SET LRTIM=$PIECE(X,"^",3)
SET LRLONG=""
SET PNM=$PIECE(X,"^",4)
SET SSN=$PIECE(X,"^",5)
+4 QUIT
Q17 ;
+1 IF $DATA(LRHYCS33(LRODT,LRSN))
IF $DATA(^LRHY(69.86,LRHYSITE,4,"B",LRHYCS33(LRODT,LRSN)))
KILL LRHYCS33(LRODT,LRSN)
QUIT
+2 SET LRHYDJOB=$ORDER(^TMP("LRHYDY",0))
+3 SET I=$ORDER(^LRO(69,LRODT,1,LRSN,6,0))
SET J=$ORDER(^(1))
if '$DATA(IOM)
SET IOM=80
KILL LRSPCDSC
if J
SET LRSPCDSC=^(J,0)
if I
SET DA=LRSN
SET DA(1)=LRODT
SET DR=6
SET DIC="^LRO(69,"_LRODT_",1,"
if I
DO EN^DIQ
DO LRSPEC^LROE1
+4 ;
+5 if $DATA(^TMP("LRHYDY",$JOB,"KILL",LRODT,LRSN))
QUIT
+6 SET LRLABLIO=LRDEV
SET ZTIO=LRDEV
+7 DO ^LRHYBL1
+8 IF $GET(LRLABSTP)'=""
SET LRLABLIO=$PIECE(^%ZIS(1,LRDEV,0),U)_";"_LRLABSTP
+9 ; get around comments on Howdy screen
+10 if $DATA(^TMP("LRHYDY",$JOB,"KILL",LRODT,LRSN))
QUIT
+11 SET DTIME=.5
+12 ;
+13 SET LRQUIET=1
+14 if $DATA(LROLT1(LRODT,LRSN))
QUIT
+15 KILL LRCCOM,X,LRCCOMX,LRCCOM0
+16 ; The call to OLD^LRORDST hands off the accessioning process and
+17 ; updating of lab files
+18 ;
+19 SET LR33ORD=LRORD
+20 ;K LRORD
+21 DO OLD^LRORDST
+22 SET LRORD=LR33ORD
+23 IF $GET(LRUID)'=""
DO NOW^%DTC
SET ^TMP("LRHYHOW1",$JOB,LRUID)=%_U_DUZ
+24 SET DTIME=$$DTIME^XUP(DUZ)
+25 DO D1^LRHYU
+26 ;
+27 SET ^LRO(69,"AA",+$GET(^LRO(69,LRODT,1,LRSN,.1)),LRODT_"|"_LRSN)=""
+28 ;
+29 ; Lines below commented out by LR*5.2*491 because:
+30 ; (1) Orders have been marked active or discontinued in file
+31 ; 100 before this code is called.
+32 ; (2) Discontinued orders are being marked active in CPRS if
+33 ; LRORIEN is the File 100 ien of the discontinued test order.
+34 ; (3) If the lines below are needed, LRORIEN would need to be
+35 ; be retrieved from the test level of file 69.
+36 ;
+37 ;S LRORIEN=$P($G(^LRO(69,LRODT,1,LRSN,0)),U,11)
+38 ;I $G(LRORIEN) D
+39 ;. D STATUS^ORCSAVE2(LRORIEN,6)
+40 if $GET(LRNOTEST)
QUIT
Begin DoDot:1
+41 KILL DA,DR
SET DIE="^LRO(69,"_LRODT_",1,"
SET DA(1)=LRODT
SET DA=LRSN
SET DR="12////"_DUZ
DO ^DIE
+42 KILL DA,DR
SET DIE="^LRO(69,"_LRODT_",1,"
SET DA(1)=LRODT
SET DA=LRSN
SET DR="13////C"
DO ^DIE
End DoDot:1
+43 QUIT
