DVBCLABR ;ALB/GTS-557/THM-PRINT C&P LAB TEST RESULTS ; 9/6/91  1:40 PM
 ;;2.7;AMIE;**11,42**;Apr 10, 1995
 ;
LAB N XX S XX=1
 F  Q:'$D(DVBCRALC(XX))  D
 .S DVBCRALC=DVBCRALC(XX)
 .S XX=XX+1 D LAB1
 Q
LAB1 ;print lab
 S STAT=$P(^DVB(396.3,DA(1),0),U,18) Q:STAT["X"  I '$D(DVBCRALC) D SETLAB^DVBCPRNT ; ** Set variable DVBCRALC
 S LRDFN=$S($D(^DPT(DFN,"LR")):+^("LR"),1:0),DTREL=$P(^DVB(396.3,DA(1),0),U,14) Q:DTREL=""
 ; ** 'CH' X-ref is for Chemistry tests, 'MI' X-ref is for Micro tests.
 D RSET S DVBCW=1 F DVBCI=0:0 S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT=""!(LRIDT>LREDT)  D LK
 D RSET S DVBCW=2 F DVBCI=0:0 S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT=""!(LRIDT>LREDT)  D LK
 ;
RAD ;print radiology
 Q:'$D(^RADPT(0))  ;quit if not running radiology package
 S RABDT=DVBCBDT,RAEDT=DTREL,RAHLOC=DVBCRALC D ^RAUTL3
 K DVBCW,RABDT,RAEDT,RAHLOC
 Q
 ;
REN I '$D(FF) D HOME^%ZIS S FF=IOF
 ;
REN1 W @FF,!,"Reprint Lab/X-Ray Results for C&P Exams",!!!
 S DIC="^DVB(396.3,",DIC(0)="AEQM" D ^DIC I X=""!(X=U) G KILL^DVBCUTIL
 I +Y>0 S DA(1)=+Y,DFN=$P(Y,U,2)
 W !! S %ZIS="AEQ",%ZIS("A")="Output device: " D ^%ZIS K %ZIS G:POP KILL^DVBCUTIL
 I $D(IO("Q")) S ZTRTN="REN2^DVBCLABR",ZTIO=ION,ZTDESC="C&P lab/radiology print" F I="DIC*","DA*","DFN" S ZTSAVE(I)=""
 I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued",!! H 2 G KILL^DVBCUTIL
REN2 U IO D SETLAB^DVBCPRNT,LAB S LKILL=1
 Q:$G(DVBGUI)  D:$D(ZTQUEUED) KILL^%ZTLOAD
 G KILL^DVBCUTIL
 ;
RSET D:'$D(LRPARAM) DT^LRX,EN^LRPARAM S (LREND,LRSTOP)=0,LRCW=8,LRHF=1,LRFOOT=0,(LRONESPC,LRONETST)=""
 S LRLAB=1,X1=DTREL,X2=-120 D C^%DTC S (DVBCBDT,LREDT)=X,LRSDT=DTREL,LRIDT=9999999-LRSDT,LREDT=9999999-LREDT D PT^LRX
 Q
 ;
LK I DVBCW=1 S DVBCRLOC=$P(^LR(LRDFN,"CH",LRIDT,0),U,11)
 I DVBCW=2 S DVBCRLOC=$P(^LR(LRDFN,"MI",LRIDT,0),U,8)
 Q:DVBCRLOC=""  ; * Quit if DVBCRLOC is NULL.
 ;
 ; ** NOTE: DVBCRALC=^Pointer to file 44^Pointer to file 44^
 ; ** NOTE: DVBCRALC pointers come from file 396.1 C&P ROUTING LOCATION
 ; ** DVBCRLOC is the REQUESTING LOCATION in the Lab Data File multiple
 F ZJ=0:0 S ZJ=$O(^SC("C",DVBCRLOC,ZJ)) Q:ZJ=""  S DVBCXLOC=U_ZJ_U I DVBCRALC[DVBCXLOC D:DVBCW=1 CH^LRRP2 D:DVBCW=2 MI^LRRP2 Q
 K DVBCXLOC