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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRRP6A3 1622 printed Nov 22, 2024@17:30:03 Page 2
LRRP6A3 ;DALISC/J0/DRH - LAB TEST SUMMARY REPORT-DETAILED ;12/08/92
+1 ;;5.2;LAB SERVICE;**101**;Sep 27, 1994
EN ;
DET ;
+1 DO HDR
+2 SET LRSUBH="Accession #: "
+3 SET LRAN=""
+4 FOR
SET LRAN=$ORDER(^TMP("LR",$JOB,"ACCNUM",LRAN))
if (LREND)!(LRAN="")
QUIT
DO ACC
+5 if LREND
QUIT
+6 WRITE !!,"TOTAL FOR ACCESSION AREA: "
+7 WRITE ?72,$JUSTIFY(^TMP("LR",$JOB),6)
+8 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE
if LREND
QUIT
WRITE @IOF
+9 QUIT
ACC ;
+1 SET LRPDT=$PIECE(LRAN,"~",2)
+2 IF $Y+9>IOSL
if $EXTRACT(IOST,1,2)="C-"
DO PAUSE
if LREND
QUIT
WRITE @IOF
DO HDR
+3 SET LRPDT=$$DTF^LRAFUNC1(LRPDT)
+4 WRITE !!,LRSUBH,$PIECE(LRAN,"~"),?53,LRPDT,!,LRDASH
+5 SET LRTNAM=""
+6 FOR
SET LRTNAM=$ORDER(^TMP("LR",$JOB,"ACCNUM",LRAN,LRTNAM))
if (LREND)!(LRTNAM="")
QUIT
Begin DoDot:1
+7 IF $Y+7>IOSL
Begin DoDot:2
+8 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE
if LREND
QUIT
WRITE @IOF
DO HDR
+9 WRITE !!,LRSUBH,LRAN," ** cont. ** ",!,LRDASH
End DoDot:2
+10 if LREND
QUIT
+11 WRITE !,LRTNAM
+12 SET LRFIRST=1
DO CAP
End DoDot:1
+13 if LREND
QUIT
+14 WRITE !,LRDASH,!,"SUBTOTAL",?72,$JUSTIFY(^TMP("LR",$JOB,"ACCNUM",LRAN),6)
+15 QUIT
CAP ;
+1 SET LRCAPNAM=""
+2 FOR
SET LRCAPNAM=$ORDER(^TMP("LR",$JOB,"ACCNUM",LRAN,LRTNAM,LRCAPNAM))
if (LREND)!(LRCAPNAM="")
QUIT
Begin DoDot:1
+3 IF $Y+6>IOSL
Begin DoDot:2
+4 if $EXTRACT(IOST,1,2)="C-"
DO PAUSE
if LREND
QUIT
WRITE @IOF
DO HDR
+5 WRITE !!,LRSUBH,LRAN," ** cont. ** ",!,LRDASH
+6 WRITE !,LRTNAM
+7 SET LRFIRST=1
End DoDot:2
+8 if LREND
QUIT
+9 if 'LRFIRST
WRITE !
+10 IF LRFIRST
SET LRFIRST=0
+11 WRITE ?9,$EXTRACT(LRCAPNAM,1,50),?60,$JUSTIFY(LRCC(LRCAPNAM),12,4)
+12 WRITE ?66,$JUSTIFY(^TMP("LR",$JOB,"ACCNUM",LRAN,LRTNAM,LRCAPNAM),6)
End DoDot:1
+13 QUIT
HDR ;
+1 SET LRPAG=LRPAG+1
+2 WRITE !,"Detailed AUDIT REPORT (by Test) for ",LRDATRNG
+3 WRITE ?62,LRDAT,?72,"PAGE ",$JUSTIFY(LRPAG,3)
+4 WRITE !,"Accession Area: ",LRX
+5 WRITE !,$EXTRACT(LRSTAR,1,34)," DETAILED ",$EXTRACT(LRSTAR,1,34)
+6 QUIT
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
+2 if ($DATA(DTOUT)#2)!($DATA(DUOUT)#2)!($DATA(DIRUT)#2)
SET LREND=1
+3 QUIT
