- 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 Jan 18, 2025@03:20:42 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