source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRRP5.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1LRRP5 ;DALOI/JBM/WTY - COLLECTION REPORT ;9/22/00
2 ;;5.2;LAB SERVICE;**121,201,248**;Sep 27, 1994
3 ;
4 ;Reference to ^%DT supported by IA #10003
5 ;Reference to ^%ZIS supported by IA #10086
6 ;Reference to ^%ZISC supported by IA #10089
7 ;Reference to ^%ZTLOAD supported by IA #10063
8 ;Reference to ^DIC supported by IA #10006
9 ;Reference to ^DIR supported by IA #10026
10 ;
11EN ;
12 S LREND=0
13 S DIR(0)="69.01,4",DIR("A")="Type of collection for report? "
14 S DIR("B")="SEND PATIENT"
15 D ^DIR
16 I ($D(DTOUT)#2)!($D(DUOUT)#2)!($D(DIRUT)#2) S LREND=1 G WRAPUP
17 S LRRCTYP=Y,LRRCNAM=Y(0)
18DATE ;
19 S %DT="AEX",%DT("A")="Date ordered? : "
20 D ^%DT I (X=U)!(X="") S LREND=1 G WRAPUP
21 S LRODT=Y,LRODAT=$$Y2K^LRX(LRODT)
22REPTYP ;
23 W !,"REPORT selection: "
24 K DIR,X,Y S DIR(0)="S^1:Detailed report;2:Summary report"
25 D ^DIR
26 I ($D(DTOUT))!($D(DUOUT)) S LREND=1 G WRAPUP
27 S LRRPT=+X
28DEVICE ;
29 K IOP,IO("Q") S %ZIS="QP" D ^%ZIS
30 I POP S LREND=1 G WRAPUP
31 I $D(IO("Q")) D QUE S LREND=1 G WRAPUP
32DQ ;
33 D INIT
34 D PROCESS
35 D CNTSUM
36 D PRINT^LRRP5A
37 D WRAPUP
38 Q
39INIT ;
40 S:$D(ZTQUEUED) ZTREQ="@" K ^TMP($J) U IO
41 S LRDAT=$$Y2K^LRX(DT),(LRPAG,LREND)=0
42 Q
43PROCESS ;For ea. specimen on date selected
44 ; If collection type = requested type
45 ; Get patient name & SSN,order#,collection sample & ordering location
46 ; Store by patient,ssn,order#,collection sample
47 S LRSN=0
48 F S LRSN=$O(^LRO(69,LRODT,1,LRSN)) Q:'+LRSN D
49 .S LRREC=$G(^LRO(69,LRODT,1,LRSN,0)) Q:LRREC=""
50 .S LRDFN=$P(LRREC,U),LRCTYP=$P(LRREC,U,4),LRLOC=$P(LRREC,U,9)
51 .Q:(LRDFN="")!(LRRCTYP'=LRCTYP)!(LRLOC="")
52 .;name/ssn
53 .S DIC=63,DIC(0)="NXZ",X="`"_LRDFN D ^DIC Q:Y=-1
54 .S LRDPF=$P(Y(0),U,2),DFN=$P(Y(0),U,3) Q:DFN="" D PT^LRX Q:PNM=""
55 .S LRPAT=PNM,LRSSN=SSN S:LRSSN="" LRSSN="NO ENTRY"
56 .;order#
57 .S LRORD=$G(^LRO(69,LRODT,1,LRSN,.1)) Q:LRORD=""
58 .S LRCLCTD=$P($G(^LRO(69,LRODT,1,LRSN,1)),U,4)
59 .;collection sample
60 .S LRCS=$P($G(^LRO(69,LRODT,1,LRSN,0)),U,3) Q:LRCS=""
61 .S DIC=62,DIC(0)="NXZ",X="`"_LRCS D ^DIC Q:Y=-1
62 .S LRCS1=$P(Y(0),U)
63 .;location
64 .S DIC=44,DIC(0)="NXZ",X="`"_LRLOC D ^DIC Q:Y=-1
65 .S LRLOC=$S(+$L($P(Y(0),U,2)):$P(Y(0),U,2),1:$P(Y,U,2))
66 .I LRCLCTD="C" D
67 ..S LRCLCTD="[C]"
68 ..S $P(^TMP($J,"LOCTOT",LRLOC,LRPAT,LRSSN,0),U)=1
69 .E D
70 ..S LRCLCTD=" "
71 ..S $P(^TMP($J,"LOCTOT",LRLOC,LRPAT,LRSSN,0),U,2)=1
72 .S LRTNN=+$G(^TMP($J,"PAT",LRPAT,LRSSN,LRORD,LRCS1,0))
73 .; For ea. test
74 .; Get name & urgency
75 .; store by patient,ssn,order#,spec,test#
76 .S LRTN=0
77 .F S LRTN=$O(^LRO(69,LRODT,1,LRSN,2,LRTN)) Q:'+LRTN D
78 ..S LRREC=$G(^LRO(69,LRODT,1,LRSN,2,LRTN,0)) Q:LRREC="" Q:$P(LRREC,"^",11)
79 ..S DIC=60,DIC(0)="NXZ",X="`"_$P(LRREC,U) D ^DIC Q:Y=-1
80 ..S LRTST=$P(Y,U,2),LRIFN=+Y,LRPNAM=$P($G(^LAB(60,LRIFN,.1)),U)
81 ..S:LRPNAM'="" LRTST=LRPNAM
82 ..S LRTST=$E(LRTST,1,7)
83 ..S DIC=62.05,DIC(0)="NXZ",X="`"_$P(LRREC,U,2) D ^DIC Q:Y=-1
84 ..S LRTST=LRTST_"("_$E($P(Y,U,2),1)_")"
85 ..S LRTNN=LRTNN+1,^TMP($J,"PAT",LRPAT,LRSSN,LRORD,LRCS1,LRTNN)=LRTST
86 .S ^TMP($J,"PAT",LRPAT,LRSSN,LRORD,LRCS1,0)=LRTNN_U_LRLOC_U_LRCLCTD
87 Q
88CNTSUM ;
89 N LRC,LRU,LRP,LRREC,LRLOC,LRPAT,LRSSN
90 S LRLOC=""
91 F S LRLOC=$O(^TMP($J,"LOCTOT",LRLOC)) Q:LRLOC="" D
92 .S LRPAT="",LRPATCNT=0
93 .F S LRPAT=$O(^TMP($J,"LOCTOT",LRLOC,LRPAT)) Q:LRPAT="" D
94 ..S LRSSN=""
95 ..F S LRSSN=$O(^TMP($J,"LOCTOT",LRLOC,LRPAT,LRSSN)) Q:LRSSN="" D
96 ...S LRREC=$G(^TMP($J,"LOCTOT",LRLOC,LRPAT,LRSSN,0))
97 ...Q:'$L(LRREC)
98 ...S LRPATCNT=LRPATCNT+1
99 ...S LRC=+$P(LRREC,U),LRU=+$P(LRREC,U,2)
100 ...S LRP=$S((LRC)&(LRU):4,('LRC)&(LRU):3,1:2)
101 ...S $P(^(0),U,LRP)=$P($G(^TMP($J,"LOCTOT",LRLOC,0)),U,LRP)+1
102 .S $P(^TMP($J,"LOCTOT",LRLOC,0),U)=LRPATCNT
103 Q
104PAUSE ;
105 K DIR S DIR(0)="E" D ^DIR
106 S:($D(DTOUT)#2)!($D(DUOUT)#2)!($D(DIRUT)#2) LREND=1
107 Q
108WRAPUP ;
109 D:($E(IOST,1,2)="C-")&('LREND) PAUSE
110 W @IOF D:'$D(ZTQUEUED) ^%ZISC
111 K ^TMP($J),LRPATCNT,LRTGLNAM,LRTGLORD,LRCLCTD,LRTNN,LRTAB
112 K DTOUT,DUOUT,DIRUT,DIROUT,X,Y,%,%ZIS,DIC,VADM,VA,VAERR,DFN,%Y,%DT,I,POP
113 K DIR,PNM,SSN,LRODAT,LRDAT,LRPAG,LRCTYP,LRRCTYP,LRRCNAM,LRDUMY,LRIFN
114 K LRTN,LRTST,LRURG,LRLOC,LRPAT,LRSSN,LRREC,LRORD,LRDFN,LRODT,LRDPF,LRWRD
115 K LRSN,LRPNAM,LRSPC,LREND,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE,ZTDESC,AGE,DOB,SEX
116 K LRLCNT,LRBUF,LRBLANK,LRCS3,LRRPT,LRCS1,ZTREQ
117 Q
118QUE ;
119 K IO("Q") I '$D(ZTIO),$D(ION),ION="" S ZTIO=""
120 S ZTDESC="LRRP5 - COLLECTION REPORT",ZTRTN="DQ^LRRP5"
121 S ZTSAVE("LR*")="" D ^%ZTLOAD
122 W:$D(ZTSK) !!,"Report queued"
123 W:'$D(ZTSK) !!,"Report canceled!"
124 D HOME^%ZIS
125 Q
Note: See TracBrowser for help on using the repository browser.