source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OSUM.m@ 1005

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1LR7OSUM ;slc/dcm - Silent Patient cum ;8/11/97
2 ;;5.2;LAB SERVICE;**121,187,230,256**;Sep 27, 1994
3DFN S LRIN=0,LRIDT=0,LREND=0,LROUT=9999999
4 K ZTRTN,DIC,X2
5 D ^LRDPA Q:Y<0
6 U IO
7 D LRLLOC,END
8 Q
9LRLLOC ;
10 N GCNT,GIOSL,CCNT,B,C,LRSB,VA,VA200,VAERR,W
11 S CCNT=1,GCNT=0,GIOSL=999999,LRLLOC=$S($L(LRWRD):LRWRD,$D(^LR(LRDFN,.1)):^(.1),1:"File Room"),SSN=" "_SSN_" "
12 S ^TMP($J,LRDFN,0)=PNM_U_SSN_U_AGE_U_LRDPF_U_DFN
13 I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("MISCELLANEOUS TESTS"))) S ^TMP($J,LRDFN,"MISC")="MISCELLANEOUS TESTS^"
14 D LRIDT^LR7OSUM1
15 D ^LR7OSUM3
16 I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("MICROBIOLOGY"))) D MICRO^LR7OSUM1
17 I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("BLOOD BANK"))) D EN^LR7OSBR
18 D EN^LR7OSAP ;Anatomic Path
19 Q
20END D END^LRACM
21 Q
22EN(Y,DFN,SDATE,EDATE,COUNT,GIOM,SUBHEAD) ;Enter here to get silent lab results
23 ;Results in "CH" subscript are stored in the Cumulative format
24 ;Headers for each format are found in ^TMP("LRH",$J,name)=ln count
25 ;Index for where tests are found in ^TMP("LRT",$J,print name)=header^line # of1st occurance. Entries without a header means that the test exists in the report, but no result.
26 ;Formatted reports are found in ^TMP("LRC",$J,ifn)
27 ;DFN=Patient
28 ;SDATE=Start date to search for results (optional)
29 ;EDATE=End date to search for results (optional)
30 ;COUNT=Count of results to send (optional)
31 ;GIOM=Right margin - default 80 (optional)
32 ;SUBHEAD=Array of subheaders from file 64.5, misc, micro & AP to show results. Null param = get all results
33 Q:'$G(DFN)
34 S LRDFN=$$LRDFN^LR7OR1(DFN)
35 Q:'LRDFN
36 K ^TMP($J,"EVAL")
37 N A,AGE,CT1,DIC,DOB,F,G,H,I,IFN,INC,J,K,LR,LRA,LRAA,LRABV,LRACT,LRADM,LRADX,LRCNT,LRCTN,LRDP,LREND,LRJ02,LRMD,LRMIT,LRN,LRNAME,LRPRAC,LRQ,LRRB,LRSAV,LRSPE,LRSPEM,LRTEST,LRTOP,LRTREA,LRUNKNOW,LRUNT,LRVAL,LRW,M,N,P,P7,S1,SP,T,X,X1,XZ,Y,Y1
38 D PT^LRX
39 S LRADM=$P($G(VAIN(7)),"^",2),LRADX=$G(VAIN(9)),CT1=0
40 K VA,VADM,VAERR,VAIN
41 D DTRNG^LR7OR1
42 S COUNT=$S($G(COUNT):COUNT,1:9999999),GIOM=$S($G(GIOM):GIOM,1:80)
43 I GIOM>240 S GIOM=240
44 S (LRIN,LRIDT)=SDATE,LROUT=EDATE,LREND=0
45 D LRLLOC,END
46 S Y=$NA(^TMP("LRC",$J))
47 Q
48TEST ;Test the output
49 N IFN
50 S IFN=0 F S IFN=$O(^TMP("LRC",$J,IFN)) Q:IFN<1 W !,^(IFN,0)
51 Q
52GET64(Y) ;Get minor headers from file 64.5
53 N I,J
54 S I=0 F S I=$O(^LAB(64.5,1,1,I)) Q:I<1 S J=0 F S J=$O(^LAB(64.5,1,1,I,1,J)) Q:J<1 S X=^(J,0),Y($P(X,"^"))=""
55 S Y("MISCELLANEOUS TESTS")=""
56 S Y("MICROBIOLOGY")=""
57 S Y("BLOOD BANK")=""
58 S Y("CYTOPATHOLOGY")=""
59 S Y("SURGICAL PATHOLOGY")=""
60 S Y("EM")=""
61 S Y("AUTOPSY")=""
62 S Y=$NA(Y)
63 Q
64PT ;Test with a loop thru multiple patients
65 N X,DFN,PTN,PTNX
66 W !!,"How many patients: " R X:DTIME Q:X["^"
67 I X'?1N.N W !!,"Enter a number" G PT
68 S DFN=0,PTNX=X
69 F PTN=1:1:PTNX S DFN=$O(^DPT(DFN)) Q:DFN<1 I $D(^DPT(DFN,"LR")) K ^TMP("LRC",$J),^TMP("LRH",$J),^TMP("LRT",$J) D EN(.Y,DFN) W !!!!,"////////////////////"_$P(^DPT(DFN,0),"^")_" LRDFN:"_+^DPT(DFN,"LR")_"////////////////////",!! D TEST
70 Q
71CLEAN ;Clean up TMP globals
72 K ^TMP("LRC",$J),^TMP("LRT",$J),^TMP("LRH",$J)
73 Q
74AP(DFN) ;Get just the AP results
75 Q:'$D(DFN)
76 N SUBHEAD,LRAU,LRV,LRZ,%I,E
77 K ^TMP("LRC",$J)
78 S SUBHEAD("CYTOPATHOLOGY")=""
79 S SUBHEAD("SURGICAL PATHOLOGY")=""
80 S SUBHEAD("EM")=""
81 S SUBHEAD("AUTOPSY")=""
82 D EN(.ZIP,DFN,,,,80,.SUBHEAD)
83 Q
Note: See TracBrowser for help on using the repository browser.