source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRACK.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1LRACK ;SLC/DCM/MILW/JMC - CHECK CUMULATIVE DEVICE STATUS ; 9/30/87 15:11 ;
2 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
3 ;
4LRIG K LRFG,LRFG1,LRFG2
5 S LRFRSEP=$P($G(^LAB(64.5,1,6)),U,2) ; Set flag if printing separate file rooms.
6 S LRIG=0
7 F S LRIG=$O(^LAB(64.5,1,3,LRIG)) Q:LRIG<1 D Q:$D(LRFG)
8 . 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.
9 . S Z=^LAB(64.5,1,3,LRIG,0)
10 . I '$L($P(Z,U,8)),$L($P(Z,U,7)) S LRFG=1,LRDT=LRLDT Q
11 . I '$L($P(Z,U,8)),'$L($P(Z,U,7)) S LRFG1=1
12 . I $L($P(Z,U,8)),$L($P(Z,U,7)) S LRFG2=1
13 . I $D(LRFG1),$D(LRFG2) S LRFG=1,LRDT=LRLDT
14 I '$D(LRFG) D
15 . S LRIG=0
16 . F S LRIG=$O(^LAB(64.5,1,3,LRIG)) Q:LRIG<1 D
17 . . 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.
18 . . S $P(^LAB(64.5,1,3,LRIG,0),U,4,8)=""
19 K LRFG,LRFG1,LRFG2,LRIG,Z
20 Q
21 ;
22EN ;
23STA ;from LRACM
24 S Y=$P(^LAB(64.5,1,0),U,3) S Y=$$Y2K^LRX(Y) S LRRDT=Y
25 S Z=$G(^LAB(64.5,1,6))
26 S Y=$P(Z,U,1) I Y S Y=$$Y2K^LRX(Y) S LRFRDT=Y
27 S LRFRSEP=$S($P(Z,U,2):"YES",1:"NO")
28 S L=0,DIC="^LAB(64.5,1,3,",FLDS="1;L15,15;L20,17;L25,18;L7,25,26,2,3"
29 S DIOEND="W !!,?10,""REPORT DATE: ""_LRRDT"
30 I $D(LRFRDT) S DIOEND=DIOEND_",!,""FILE ROOM REPORT DATE: ""_LRFRDT"
31 S DIOEND=DIOEND_",!,"" SEPARATE FILE ROOM: ""_LRFRSEP"
32 S BY=".01;S1",FR="",TO="",DHD="CUMULATIVE DEVICE STATUS"
33 D EN1^DIP,^%ZISC
34 K LRFRDT,LRFRSEP,LRRDT,L,DIC,DHD,DIOEND,FLDS,BY,FR,TO,Y
35 Q
Note: See TracBrowser for help on using the repository browser.