LRACK ;SLC/DCM/MILW/JMC - CHECK CUMULATIVE DEVICE STATUS ; 9/30/87 15:11 ;
;;5.2;LAB SERVICE;**201**;Sep 27, 1994
;
LRIG K LRFG,LRFG1,LRFG2
S LRFRSEP=$P($G(^LAB(64.5,1,6)),U,2) ; Set flag if printing separate file rooms.
S LRIG=0
F S LRIG=$O(^LAB(64.5,1,3,LRIG)) Q:LRIG<1 D Q:$D(LRFG)
. I LRFRSEP,$P($G(^LAB(64.5,1,3,LRIG,.1)),U,3) Q ; Printing file room on separate schedule and this is a file room report.
. S Z=^LAB(64.5,1,3,LRIG,0)
. I '$L($P(Z,U,8)),$L($P(Z,U,7)) S LRFG=1,LRDT=LRLDT Q
. I '$L($P(Z,U,8)),'$L($P(Z,U,7)) S LRFG1=1
. I $L($P(Z,U,8)),$L($P(Z,U,7)) S LRFG2=1
. I $D(LRFG1),$D(LRFG2) S LRFG=1,LRDT=LRLDT
I '$D(LRFG) D
. S LRIG=0
. F S LRIG=$O(^LAB(64.5,1,3,LRIG)) Q:LRIG<1 D
. . I LRFRSEP,$P($G(^LAB(64.5,1,3,LRIG,.1)),U,3) Q ; Printing file room on separate schedule and this is a file room report.
. . S $P(^LAB(64.5,1,3,LRIG,0),U,4,8)=""
K LRFG,LRFG1,LRFG2,LRIG,Z
Q
;
EN ;
STA ;from LRACM
S Y=$P(^LAB(64.5,1,0),U,3) S Y=$$Y2K^LRX(Y) S LRRDT=Y
S Z=$G(^LAB(64.5,1,6))
S Y=$P(Z,U,1) I Y S Y=$$Y2K^LRX(Y) S LRFRDT=Y
S LRFRSEP=$S($P(Z,U,2):"YES",1:"NO")
S L=0,DIC="^LAB(64.5,1,3,",FLDS="1;L15,15;L20,17;L25,18;L7,25,26,2,3"
S DIOEND="W !!,?10,""REPORT DATE: ""_LRRDT"
I $D(LRFRDT) S DIOEND=DIOEND_",!,""FILE ROOM REPORT DATE: ""_LRFRDT"
S DIOEND=DIOEND_",!,"" SEPARATE FILE ROOM: ""_LRFRSEP"
S BY=".01;S1",FR="",TO="",DHD="CUMULATIVE DEVICE STATUS"
D EN1^DIP,^%ZISC
K LRFRDT,LRFRSEP,LRRDT,L,DIC,DHD,DIOEND,FLDS,BY,FR,TO,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRACK 1515 printed Oct 16, 2024@18:07:06 Page 2
LRACK ;SLC/DCM/MILW/JMC - CHECK CUMULATIVE DEVICE STATUS ; 9/30/87 15:11 ;
+1 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
+2 ;
LRIG KILL LRFG,LRFG1,LRFG2
+1 ; Set flag if printing separate file rooms.
SET LRFRSEP=$PIECE($GET(^LAB(64.5,1,6)),U,2)
+2 SET LRIG=0
+3 FOR
SET LRIG=$ORDER(^LAB(64.5,1,3,LRIG))
if LRIG<1
QUIT
Begin DoDot:1
+4 ; Printing file room on separate schedule and this is a file room report.
IF LRFRSEP
IF $PIECE($GET(^LAB(64.5,1,3,LRIG,.1)),U,3)
QUIT
+5 SET Z=^LAB(64.5,1,3,LRIG,0)
+6 IF '$LENGTH($PIECE(Z,U,8))
IF $LENGTH($PIECE(Z,U,7))
SET LRFG=1
SET LRDT=LRLDT
QUIT
+7 IF '$LENGTH($PIECE(Z,U,8))
IF '$LENGTH($PIECE(Z,U,7))
SET LRFG1=1
+8 IF $LENGTH($PIECE(Z,U,8))
IF $LENGTH($PIECE(Z,U,7))
SET LRFG2=1
+9 IF $DATA(LRFG1)
IF $DATA(LRFG2)
SET LRFG=1
SET LRDT=LRLDT
End DoDot:1
if $DATA(LRFG)
QUIT
+10 IF '$DATA(LRFG)
Begin DoDot:1
+11 SET LRIG=0
+12 FOR
SET LRIG=$ORDER(^LAB(64.5,1,3,LRIG))
if LRIG<1
QUIT
Begin DoDot:2
+13 ; Printing file room on separate schedule and this is a file room report.
IF LRFRSEP
IF $PIECE($GET(^LAB(64.5,1,3,LRIG,.1)),U,3)
QUIT
+14 SET $PIECE(^LAB(64.5,1,3,LRIG,0),U,4,8)=""
End DoDot:2
End DoDot:1
+15 KILL LRFG,LRFG1,LRFG2,LRIG,Z
+16 QUIT
+17 ;
EN ;
STA ;from LRACM
+1 SET Y=$PIECE(^LAB(64.5,1,0),U,3)
SET Y=$$Y2K^LRX(Y)
SET LRRDT=Y
+2 SET Z=$GET(^LAB(64.5,1,6))
+3 SET Y=$PIECE(Z,U,1)
IF Y
SET Y=$$Y2K^LRX(Y)
SET LRFRDT=Y
+4 SET LRFRSEP=$SELECT($PIECE(Z,U,2):"YES",1:"NO")
+5 SET L=0
SET DIC="^LAB(64.5,1,3,"
SET FLDS="1;L15,15;L20,17;L25,18;L7,25,26,2,3"
+6 SET DIOEND="W !!,?10,""REPORT DATE: ""_LRRDT"
+7 IF $DATA(LRFRDT)
SET DIOEND=DIOEND_",!,""FILE ROOM REPORT DATE: ""_LRFRDT"
+8 SET DIOEND=DIOEND_",!,"" SEPARATE FILE ROOM: ""_LRFRSEP"
+9 SET BY=".01;S1"
SET FR=""
SET TO=""
SET DHD="CUMULATIVE DEVICE STATUS"
+10 DO EN1^DIP
DO ^%ZISC
+11 KILL LRFRDT,LRFRSEP,LRRDT,L,DIC,DHD,DIOEND,FLDS,BY,FR,TO,Y
+12 QUIT
