- 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 Jan 18, 2025@03:07:03 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