source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPBR3.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: 3.5 KB
Line 
1LRAPBR3 ;DALOI/WTY - AP Browser Print Cont.;04/06/01
2 ;;5.2;LAB SERVICE;**259**;Sep 27, 1994
3 ;
4 ; This routine was created from LRSPRPT1 to be used for printing
5 ; the SF515 to the browser and storing the report in a global format
6 ; This routine displays any special studies. Printing of SNOMED
7 ; codes and associated journal references (if any) has been removed.
8MAIN ;
9 N LRTP,LRCNT1,LRA1,LRFILE,LRFILE1
10 N LRIENS1,LRA2
11 Q:$G(LRSF)=""
12 S LRA1=0,LRIENS=LRI_","_LRDFN_","
13 S LRFILE=+$$GET1^DID(LRSF,10,"","SPECIFIER")
14 F S LRA1=$O(^LR(LRDFN,LRSS,LRI,2,LRA1)) Q:'LRA1 D
15 .S LRIENS1=LRA1_","_LRIENS
16 .S LRTP(1)=$$GET1^DIQ(LRFILE,LRIENS1,.01)
17 .S LRTP(2)=$$GET1^DIQ(LRFILE,LRIENS1,.01,"I")
18 .S LRTP(8)=$$GET1^DIQ(LRFILE,LRIENS1,".01:2")
19 .D SPCSTD
20 .D JRNLREF
21 Q
22SPCSTD ;Display Special Studies
23 Q:'$P($G(^LR(LRDFN,LRSS,LRI,2,LRA1,5,0)),"^",4)
24 D GLENTRY("SPECIAL STUDIES:","",1)
25 N LRX,DIWR,DIWL,LRC,LRTMP
26 S LRC=0 F S LRC=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,5,LRC)) Q:'LRC D
27 .S LRFILE1=+$$GET1^DID(LRFILE,5,"","SPECIFIER")
28 .F I=.01:.01:.03 D
29 ..S LRTP(I)=$$GET1^DIQ(LRFILE1,LRC_","_LRIENS1,I)
30 .D GLENTRY("","",1)
31 .D GLENTRY(LRTP(.01)_" "_LRTP(.03)_" Date: "_LRTP(.02),"",1)
32 .D GLENTRY(LRTP(1),"",1)
33 .K ^UTILITY($J,"W")
34 .S LRX=$$GET1^DIQ(LRFILE1,LRA1_","_LRIENS1,1,"","LRTMP")
35 .S DIWR=IOM-10,DIWL=10,DIWF=""
36 .S LRX=+$$GET1^DID(LRFILE1,1,"","SPECIFIER")
37 .I $$GET1^DID(LRX,.01,"","SPECIFIER")["L" S DIWF="N"
38 .S LRA2=0 F S LRA2=$O(LRTMP(LRA2)) Q:'LRA2 S X=LRTMP(LRA2) D ^DIWP
39 .S LRA2=0 F S LRA2=$O(^UTILITY($J,"W",DIWL,LRA2)) Q:'LRA2 D
40 ..D GLENTRY(^UTILITY($J,"W",DIWL,LRA2,0),DIWL,1)
41 .K ^UTILITY($J,"W")
42 Q
43 ;
44JRNLREF ;Display Journal References
45 ;Topography
46 N LRFL,LRM,LRN
47 S LRFL=LRTP(2),LRFILE1=61 D JREFPRT
48 ;Morphology
49 S LRFILE1=61.1,LRFILE3=+$$GET1^DID(LRFILE,4,"","SPECIFIER")
50 S LRM=0 F S LRM=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,2,LRM)) Q:'LRM D
51 .S LRIENS2=LRM_","_LRIENS1
52 .S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
53 .D JREFPRT
54 .;Etiology
55 .S LRFILE1=61.2,LRFILE4=+$$GET1^DID(LRFILE3,1,"","SPECIFIER")
56 .S LRN=0 F S LRN=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,2,LRM,1,LRN)) Q:'LRN D
57 ..S LRIENS3=LRN_","_LRIENS2
58 ..S LRFL=$$GET1^DIQ(LRFILE4,LRIENS3,.01,"I")
59 ..D JREFPRT
60 ;Disease
61 S LRFILE1=61.4,LRFILE3=+$$GET1^DID(LRFILE,3,"","SPECIFIER")
62 S LRM=0 F S LRM=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,1,LRM)) Q:'LRM D
63 .S LRIENS2=LRM_","_LRIENS1
64 .S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
65 .D JREFPRT
66 ;Function
67 S LRFILE1=61.3,LRFILE3=+$$GET1^DID(LRFILE,1,"","SPECIFIER")
68 S LRM=0 F S LRM=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,3,LRM)) Q:'LRM D
69 .S LRIENS2=LRM_","_LRIENS1
70 .S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
71 .D JREFPRT
72 Q
73JREFPRT ;
74 ; Print journal reference on the patient report if the
75 ; reference is flagged for printing.
76 N LRJR,LRINC
77 S LRFILE2=+$$GET1^DID(LRFILE1,5,"","SPECIFIER")
78 S LRJR=0 F S LRJR=$O(^LAB(LRFILE1,LRFL,"JR",LRJR)) Q:'LRJR D
79 .S LRJR(.01)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",.01)
80 .F LRINC=1:1:5 D
81 ..S LRJR(LRINC)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",LRINC)
82 .S LRJR(6)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",6,"I")
83 .Q:'LRJR(6)
84 .D GLENTRY(,,1),GLENTRY("Reference: ",,1)
85 .D GLENTRY(LRJR(.01),,1)
86 .D GLENTRY(LRJR(1),,1),GLENTRY(,,1)
87 .I LRJR(2)'="" D
88 ..D GLENTRY(LRJR(2)_" vol."_LRJR(3),BTAB)
89 ..D GLENTRY(" pg."_LRJR(4),BTAB)
90 .D GLENTRY(" Date: "_LRJR(5),BTAB)
91 Q
92GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global
93 ;LRPR1 = Text to be written to global
94 ;LRPR2 = Tab position
95 ;LRPR3 = 1 means start a new line. Othewise, write on current line.
96 S LRPR1=$G(LRPR1),LRPR2=+$G(LRPR2),LRPR3=+$G(LRPR3)
97 D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)
98 D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)
99 Q
Note: See TracBrowser for help on using the repository browser.