source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRRP5A.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1LRRP5A ;DALISC/JBM - COLLECTION REPORT-PRINT ;10/20/92
2 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
3EN ;
4PRINT ;
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
14DET ;
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
53PRNTBUF ;
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
67SUM ;
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
88SUMHDR ;
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
100HDR ;
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
108PAUSE ;
109 K DIR S DIR(0)="E" D ^DIR
110 S:($D(DTOUT)#2)!($D(DUOUT)#2)!($D(DIRUT)#2) LREND=1
111 Q
Note: See TracBrowser for help on using the repository browser.