1 | LRRP5A ;DALISC/JBM - COLLECTION REPORT-PRINT ;10/20/92
|
---|
2 | ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
|
---|
3 | EN ;
|
---|
4 | PRINT ;
|
---|
5 | W:$E(IOST,1,2)="C-" @IOF
|
---|
6 | I LRRPT=1 D
|
---|
7 | .D DET
|
---|
8 | .Q:LREND
|
---|
9 | .D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF
|
---|
10 | Q:LREND
|
---|
11 | D SUM Q:LREND
|
---|
12 | W !!?23,"*** END OF REPORT ***"
|
---|
13 | Q
|
---|
14 | DET ;
|
---|
15 | F I=1:1:80 S $P(LRBLANK," ",80)=" "
|
---|
16 | D HDR
|
---|
17 | S LRPAT="",LRPATCNT=0
|
---|
18 | F S LRPAT=$O(^TMP($J,"PAT",LRPAT)) Q:(LRPAT="")!(LREND) D
|
---|
19 | .S LRSSN=""
|
---|
20 | .F S LRSSN=$O(^TMP($J,"PAT",LRPAT,LRSSN)) Q:(LRSSN="")!(LREND) D
|
---|
21 | ..S LRLCNT=0 K LRBUF
|
---|
22 | ..S LRORD="",LRPATCNT=LRPATCNT+1,LRTGLNAM=1
|
---|
23 | ..F S LRORD=$O(^TMP($J,"PAT",LRPAT,LRSSN,LRORD)) Q:(LRORD="")!(LREND) D
|
---|
24 | ...S LRCS1="",LRTGLORD=1
|
---|
25 | ...F S LRCS1=$O(^TMP($J,"PAT",LRPAT,LRSSN,LRORD,LRCS1)) Q:(LRCS1="")!(LREND) D
|
---|
26 | ....S LRLOC=$P(^TMP($J,"PAT",LRPAT,LRSSN,LRORD,LRCS1,0),U,2)
|
---|
27 | ....S LRCLCTD=$P(^TMP($J,"PAT",LRPAT,LRSSN,LRORD,LRCS1,0),U,3)
|
---|
28 | ....I LRTGLNAM D
|
---|
29 | .....S LRLCNT=LRLCNT+1,LRBUF(LRLCNT)=$E(LRPAT_LRBLANK,1,18)_" "_LRSSN
|
---|
30 | .....S LRTGLNAM=0
|
---|
31 | ....S LRLCNT=LRLCNT+1
|
---|
32 | ....I LRTGLORD D
|
---|
33 | .....S LRBUF(LRLCNT)=" "_$E(LRORD_LRBLANK,1,9)
|
---|
34 | .....S LRTGLORD=0
|
---|
35 | ....E S LRBUF(LRLCNT)=$E(LRBLANK,1,11)
|
---|
36 | ....S LRBUF(LRLCNT)=LRBUF(LRLCNT)_$E(LRLOC_LRBLANK,1,7)_" "
|
---|
37 | ....S LRBUF(LRLCNT)=LRBUF(LRLCNT)_$E(LRCS1_LRBLANK,1,10)_" "_LRCLCTD
|
---|
38 | ....S LRTAB="",LRTN=0
|
---|
39 | ....F S LRTN=$O(^TMP($J,"PAT",LRPAT,LRSSN,LRORD,LRCS1,LRTN)) Q:(LRTN="")!(LREND) D
|
---|
40 | .....S LRTST=$E((^TMP($J,"PAT",LRPAT,LRSSN,LRORD,LRCS1,LRTN)_" "),1,10)
|
---|
41 | .....I $L(LRBUF(LRLCNT))>70 D
|
---|
42 | ......S LRLCNT=LRLCNT+1,LRBUF(LRLCNT)=""
|
---|
43 | ......S LRTAB=$E(LRBLANK,1,22)
|
---|
44 | .....S LRBUF(LRLCNT)=LRBUF(LRLCNT)_LRTAB_LRTST
|
---|
45 | .....S LRTAB=" "
|
---|
46 | ..D PRNTBUF
|
---|
47 | ..Q:LREND
|
---|
48 | Q:LREND
|
---|
49 | I ($Y>(IOSL-7)) D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF D HDR
|
---|
50 | F I=$Y:1:(IOSL-6) W !
|
---|
51 | W "NUMBER OF PATIENTS LISTED : ",LRPATCNT
|
---|
52 | Q
|
---|
53 | PRNTBUF ;
|
---|
54 | I ((LRLCNT+$Y)>(IOSL-6))&($Y>7) D
|
---|
55 | .D:$E(IOST,1,2)="C-" PAUSE Q:LREND
|
---|
56 | .W @IOF D HDR
|
---|
57 | Q:LREND
|
---|
58 | F L=1:1:LRLCNT Q:LREND D
|
---|
59 | .I ($Y>(IOSL-6)) D
|
---|
60 | ..D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF D HDR
|
---|
61 | ..W !,$E(LRPAT,1,18),?20,LRSSN,?35,"*CONT*"
|
---|
62 | .Q:LREND
|
---|
63 | .W !,LRBUF(L)
|
---|
64 | Q:LREND
|
---|
65 | W !
|
---|
66 | Q
|
---|
67 | SUM ;
|
---|
68 | N LRN,LRC,LRU,LRP,LRREC,LRLOC,LRGN,LRGC,LRGU,LRGP,I
|
---|
69 | S (LRGN,LRGC,LRGU,LRGP)=0
|
---|
70 | D SUMHDR
|
---|
71 | S LRLOC=""
|
---|
72 | F S LRLOC=$O(^TMP($J,"LOCTOT",LRLOC)) Q:(LRLOC="")!(LREND) D
|
---|
73 | .S LRREC=$G(^TMP($J,"LOCTOT",LRLOC,0))
|
---|
74 | .Q:'$L(LRREC)
|
---|
75 | .S LRN=+$P(LRREC,U),LRC=+$P(LRREC,U,2)
|
---|
76 | .S LRU=+$P(LRREC,U,3),LRP=+$P(LRREC,U,4)
|
---|
77 | .S LRGN=LRGN+LRN,LRGC=LRGC+LRC,LRGU=LRGU+LRU,LRGP=LRGP+LRP
|
---|
78 | .I ($Y>(IOSL-6)) D
|
---|
79 | ..D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF D SUMHDR
|
---|
80 | .Q:LREND
|
---|
81 | .W LRLOC,?10,$J(LRN,8),?20,$J(LRC,9),?31,$J(LRU,11),?44,$J(LRP,11),!
|
---|
82 | Q:LREND
|
---|
83 | F I=1:1:80 W "-"
|
---|
84 | W !
|
---|
85 | W "TOTAL",?10,$J(LRGN,8),?20,$J(LRGC,9)
|
---|
86 | W ?31,$J(LRGU,11),?44,$J(LRGP,11),!
|
---|
87 | Q
|
---|
88 | SUMHDR ;
|
---|
89 | N I
|
---|
90 | S LRPAG=LRPAG+1 F I=1:1:80 W "-"
|
---|
91 | W !,"LAB ORDERS BY COLLECTION TYPE"
|
---|
92 | W !,LRRCNAM," ORDERS ON "
|
---|
93 | W LRODAT," -- SUMMARY",?62,LRDAT,?72," PAGE ",LRPAG,!
|
---|
94 | W !?44,"Partially",!
|
---|
95 | W "Location",?10,"Patients",?20,"Collected",?31,"Uncollected"
|
---|
96 | W ?44,"Collected",!
|
---|
97 | F I=1:1:80 W "-"
|
---|
98 | W !
|
---|
99 | Q
|
---|
100 | HDR ;
|
---|
101 | S (LRTGLNAM,LRTGLORD)=1,LRPAG=LRPAG+1 F I=1:1:80 W "-"
|
---|
102 | W !,"LAB ORDERS BY COLLECTION TYPE"
|
---|
103 | W !,LRRCNAM," ORDERS ON "
|
---|
104 | W LRODAT,?(62),LRDAT,?(72)," PAGE ",LRPAG
|
---|
105 | W !!,"Name",?20,"SSN",!?2,"Order #",?11,"Location",?20,"Coll Sample"
|
---|
106 | W ?34,"Tests",! F I=1:1:80 W "-"
|
---|
107 | Q
|
---|
108 | PAUSE ;
|
---|
109 | K DIR S DIR(0)="E" D ^DIR
|
---|
110 | S:($D(DTOUT)#2)!($D(DUOUT)#2)!($D(DIRUT)#2) LREND=1
|
---|
111 | Q
|
---|