55 lines
1.5 KiB
Mathematica
55 lines
1.5 KiB
Mathematica
LRRP6A3 ;DALISC/J0/DRH - LAB TEST SUMMARY REPORT-DETAILED ;12/08/92
|
|
;;5.2;LAB SERVICE;**101**;Sep 27, 1994
|
|
EN ;
|
|
DET ;
|
|
D HDR
|
|
S LRSUBH="Accession #: "
|
|
S LRAN=""
|
|
F S LRAN=$O(^TMP("LR",$J,"ACCNUM",LRAN)) Q:(LREND)!(LRAN="") D ACC
|
|
Q:LREND
|
|
W !!,"TOTAL FOR ACCESSION AREA: "
|
|
W ?72,$J(^TMP("LR",$J),6)
|
|
D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF
|
|
Q
|
|
ACC ;
|
|
S LRPDT=$P(LRAN,"~",2)
|
|
I $Y+9>IOSL D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF D HDR
|
|
S LRPDT=$$DTF^LRAFUNC1(LRPDT)
|
|
W !!,LRSUBH,$P(LRAN,"~"),?53,LRPDT,!,LRDASH
|
|
S LRTNAM=""
|
|
F S LRTNAM=$O(^TMP("LR",$J,"ACCNUM",LRAN,LRTNAM)) Q:(LREND)!(LRTNAM="") D
|
|
. I $Y+7>IOSL D
|
|
. . D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF D HDR
|
|
. . W !!,LRSUBH,LRAN," ** cont. ** ",!,LRDASH
|
|
. Q:LREND
|
|
. W !,LRTNAM
|
|
. S LRFIRST=1 D CAP
|
|
Q:LREND
|
|
W !,LRDASH,!,"SUBTOTAL",?72,$J(^TMP("LR",$J,"ACCNUM",LRAN),6)
|
|
Q
|
|
CAP ;
|
|
S LRCAPNAM=""
|
|
F S LRCAPNAM=$O(^TMP("LR",$J,"ACCNUM",LRAN,LRTNAM,LRCAPNAM)) Q:(LREND)!(LRCAPNAM="") D
|
|
. I $Y+6>IOSL D
|
|
. . D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF D HDR
|
|
. . W !!,LRSUBH,LRAN," ** cont. ** ",!,LRDASH
|
|
. . W !,LRTNAM
|
|
. . S LRFIRST=1
|
|
. Q:LREND
|
|
. W:'LRFIRST !
|
|
. I LRFIRST S LRFIRST=0
|
|
. W ?9,$E(LRCAPNAM,1,50),?60,$J(LRCC(LRCAPNAM),12,4)
|
|
. W ?66,$J(^TMP("LR",$J,"ACCNUM",LRAN,LRTNAM,LRCAPNAM),6)
|
|
Q
|
|
HDR ;
|
|
S LRPAG=LRPAG+1
|
|
W !,"Detailed AUDIT REPORT (by Test) for ",LRDATRNG
|
|
W ?62,LRDAT,?72,"PAGE ",$J(LRPAG,3)
|
|
W !,"Accession Area: ",LRX
|
|
W !,$E(LRSTAR,1,34)," DETAILED ",$E(LRSTAR,1,34)
|
|
Q
|
|
PAUSE ;
|
|
K DIR S DIR(0)="E" D ^DIR
|
|
S:($D(DTOUT)#2)!($D(DUOUT)#2)!($D(DIRUT)#2) LREND=1
|
|
Q
|