| [613] | 1 | DVBCLABR ;ALB/GTS-557/THM-PRINT C&P LAB TEST RESULTS ; 9/6/91 1:40 PM
|
|---|
| 2 | ;;2.7;AMIE;**11,42**;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | LAB N XX S XX=1
|
|---|
| 5 | F Q:'$D(DVBCRALC(XX)) D
|
|---|
| 6 | .S DVBCRALC=DVBCRALC(XX)
|
|---|
| 7 | .S XX=XX+1 D LAB1
|
|---|
| 8 | Q
|
|---|
| 9 | LAB1 ;print lab
|
|---|
| 10 | S STAT=$P(^DVB(396.3,DA(1),0),U,18) Q:STAT["X" I '$D(DVBCRALC) D SETLAB^DVBCPRNT ; ** Set variable DVBCRALC
|
|---|
| 11 | S LRDFN=$S($D(^DPT(DFN,"LR")):+^("LR"),1:0),DTREL=$P(^DVB(396.3,DA(1),0),U,14) Q:DTREL=""
|
|---|
| 12 | ; ** 'CH' X-ref is for Chemistry tests, 'MI' X-ref is for Micro tests.
|
|---|
| 13 | D RSET S DVBCW=1 F DVBCI=0:0 S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT=""!(LRIDT>LREDT) D LK
|
|---|
| 14 | D RSET S DVBCW=2 F DVBCI=0:0 S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT=""!(LRIDT>LREDT) D LK
|
|---|
| 15 | ;
|
|---|
| 16 | RAD ;print radiology
|
|---|
| 17 | Q:'$D(^RADPT(0)) ;quit if not running radiology package
|
|---|
| 18 | S RABDT=DVBCBDT,RAEDT=DTREL,RAHLOC=DVBCRALC D ^RAUTL3
|
|---|
| 19 | K DVBCW,RABDT,RAEDT,RAHLOC
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | REN I '$D(FF) D HOME^%ZIS S FF=IOF
|
|---|
| 23 | ;
|
|---|
| 24 | REN1 W @FF,!,"Reprint Lab/X-Ray Results for C&P Exams",!!!
|
|---|
| 25 | S DIC="^DVB(396.3,",DIC(0)="AEQM" D ^DIC I X=""!(X=U) G KILL^DVBCUTIL
|
|---|
| 26 | I +Y>0 S DA(1)=+Y,DFN=$P(Y,U,2)
|
|---|
| 27 | W !! S %ZIS="AEQ",%ZIS("A")="Output device: " D ^%ZIS K %ZIS G:POP KILL^DVBCUTIL
|
|---|
| 28 | I $D(IO("Q")) S ZTRTN="REN2^DVBCLABR",ZTIO=ION,ZTDESC="C&P lab/radiology print" F I="DIC*","DA*","DFN" S ZTSAVE(I)=""
|
|---|
| 29 | I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued",!! H 2 G KILL^DVBCUTIL
|
|---|
| 30 | REN2 U IO D SETLAB^DVBCPRNT,LAB S LKILL=1
|
|---|
| 31 | Q:$G(DVBGUI) D:$D(ZTQUEUED) KILL^%ZTLOAD
|
|---|
| 32 | G KILL^DVBCUTIL
|
|---|
| 33 | ;
|
|---|
| 34 | RSET D:'$D(LRPARAM) DT^LRX,EN^LRPARAM S (LREND,LRSTOP)=0,LRCW=8,LRHF=1,LRFOOT=0,(LRONESPC,LRONETST)=""
|
|---|
| 35 | 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
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | LK I DVBCW=1 S DVBCRLOC=$P(^LR(LRDFN,"CH",LRIDT,0),U,11)
|
|---|
| 39 | I DVBCW=2 S DVBCRLOC=$P(^LR(LRDFN,"MI",LRIDT,0),U,8)
|
|---|
| 40 | Q:DVBCRLOC="" ; * Quit if DVBCRLOC is NULL.
|
|---|
| 41 | ;
|
|---|
| 42 | ; ** NOTE: DVBCRALC=^Pointer to file 44^Pointer to file 44^
|
|---|
| 43 | ; ** NOTE: DVBCRALC pointers come from file 396.1 C&P ROUTING LOCATION
|
|---|
| 44 | ; ** DVBCRLOC is the REQUESTING LOCATION in the Lab Data File multiple
|
|---|
| 45 | 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
|
|---|
| 46 | K DVBCXLOC
|
|---|
