- LRHYPH2 ;VA/DALOI/HOAK - HOWDY ORDER NUMBER SELECTION ; 13-Aug-2013 09:16 ; MKK
- ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997
- ;
- ; 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
- 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)=""
- 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
- LRHYPH2 ;VA/DALOI/HOAK - HOWDY ORDER NUMBER SELECTION ; 13-Aug-2013 09:16 ; MKK
- +1 ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997
- +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
- 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 KILL 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 SET LRORIEN=$PIECE($GET(^LRO(69,LRODT,1,LRSN,0)),U,11)
- +29 IF $GET(LRORIEN)
- Begin DoDot:1
- +30 DO STATUS^ORCSAVE2(LRORIEN,6)
- End DoDot:1
- +31 IF $GET(LRNOTEST)
- QUIT
- Begin DoDot:1
- +32 KILL DA,DR
- SET DIE="^LRO(69,"_LRODT_",1,"
- SET DA(1)=LRODT
- SET DA=LRSN
- SET DR="12////"_DUZ
- DO ^DIE
- +33 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
- +34 QUIT
