1 | LRRP6A3 ;DALISC/J0/DRH - LAB TEST SUMMARY REPORT-DETAILED ;12/08/92
|
---|
2 | ;;5.2;LAB SERVICE;**101**;Sep 27, 1994
|
---|
3 | EN ;
|
---|
4 | DET ;
|
---|
5 | D HDR
|
---|
6 | S LRSUBH="Accession #: "
|
---|
7 | S LRAN=""
|
---|
8 | F S LRAN=$O(^TMP("LR",$J,"ACCNUM",LRAN)) Q:(LREND)!(LRAN="") D ACC
|
---|
9 | Q:LREND
|
---|
10 | W !!,"TOTAL FOR ACCESSION AREA: "
|
---|
11 | W ?72,$J(^TMP("LR",$J),6)
|
---|
12 | D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF
|
---|
13 | Q
|
---|
14 | ACC ;
|
---|
15 | S LRPDT=$P(LRAN,"~",2)
|
---|
16 | I $Y+9>IOSL D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF D HDR
|
---|
17 | S LRPDT=$$DTF^LRAFUNC1(LRPDT)
|
---|
18 | W !!,LRSUBH,$P(LRAN,"~"),?53,LRPDT,!,LRDASH
|
---|
19 | S LRTNAM=""
|
---|
20 | F S LRTNAM=$O(^TMP("LR",$J,"ACCNUM",LRAN,LRTNAM)) Q:(LREND)!(LRTNAM="") D
|
---|
21 | . I $Y+7>IOSL D
|
---|
22 | . . D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF D HDR
|
---|
23 | . . W !!,LRSUBH,LRAN," ** cont. ** ",!,LRDASH
|
---|
24 | . Q:LREND
|
---|
25 | . W !,LRTNAM
|
---|
26 | . S LRFIRST=1 D CAP
|
---|
27 | Q:LREND
|
---|
28 | W !,LRDASH,!,"SUBTOTAL",?72,$J(^TMP("LR",$J,"ACCNUM",LRAN),6)
|
---|
29 | Q
|
---|
30 | CAP ;
|
---|
31 | S LRCAPNAM=""
|
---|
32 | F S LRCAPNAM=$O(^TMP("LR",$J,"ACCNUM",LRAN,LRTNAM,LRCAPNAM)) Q:(LREND)!(LRCAPNAM="") D
|
---|
33 | . I $Y+6>IOSL D
|
---|
34 | . . D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF D HDR
|
---|
35 | . . W !!,LRSUBH,LRAN," ** cont. ** ",!,LRDASH
|
---|
36 | . . W !,LRTNAM
|
---|
37 | . . S LRFIRST=1
|
---|
38 | . Q:LREND
|
---|
39 | . W:'LRFIRST !
|
---|
40 | . I LRFIRST S LRFIRST=0
|
---|
41 | . W ?9,$E(LRCAPNAM,1,50),?60,$J(LRCC(LRCAPNAM),12,4)
|
---|
42 | . W ?66,$J(^TMP("LR",$J,"ACCNUM",LRAN,LRTNAM,LRCAPNAM),6)
|
---|
43 | Q
|
---|
44 | HDR ;
|
---|
45 | S LRPAG=LRPAG+1
|
---|
46 | W !,"Detailed AUDIT REPORT (by Test) for ",LRDATRNG
|
---|
47 | W ?62,LRDAT,?72,"PAGE ",$J(LRPAG,3)
|
---|
48 | W !,"Accession Area: ",LRX
|
---|
49 | W !,$E(LRSTAR,1,34)," DETAILED ",$E(LRSTAR,1,34)
|
---|
50 | Q
|
---|
51 | PAUSE ;
|
---|
52 | K DIR S DIR(0)="E" D ^DIR
|
---|
53 | S:($D(DTOUT)#2)!($D(DUOUT)#2)!($D(DIRUT)#2) LREND=1
|
---|
54 | Q
|
---|