Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRHYPH2

LRHYPH2.m

Go to the documentation of this file.
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