LRACK.m

LRACK ; IHS/DIR/AAB - CHECK CUMULATIVE DEVICE STATUS 9/30/87 15:11 ; [ 07/22/2002  12:28 PM ]

 ;;5.2;LR;**1006,1013**;JUL 15, 2002

 ;

 ;;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

LRACK     ; IHS/DIR/AAB - CHECK CUMULATIVE DEVICE STATUS 9/30/87 15:11 ; [ 07/22/2002  12:28 PM ]

 +1       ;;5.2;LR;**1006,1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;**201**;Sep 27, 1994

 +4       ;

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