source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOCOC.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1ONCOCOC ;Hines OIFO/GWB - COMPUTED FIELDS FOR CASEFINDING REPORTS ;05/25/00
2 ;;2.11;ONCOLOGY;**13,16,24,26,33,43**;Mar 07, 1995
3 ;
4LAB ;LAB CASEFINDING REPORT (160,53)
5 D GET G EX:O2=""
6 S SR=$P(O2,U,3) G EX:$E(SR,1)'="L"
7 S SR=$E(SR,2),LRSS=$S(SR="S":"SP",SR="C":"CY",SR="E":"EM",1:"AU")
8 S XDT=$P(O2,U,1),MO=$P(O2,U,5),TO=$P(O2,U,6),DZ=$P(O2,U,14)
9 S TO=$S(TO="":"None",1:"T-"_$P(^LAB(61,+TO,0),U,2)_" "_$P(^LAB(61,+TO,0),U,1))
10 S MODZ="None"
11 I MO S MODZ=$G(^LAB(61.1,+MO,0)),MODZ=$E($P(MODZ,U,2),1,4)_"/"_$E($P(MODZ,U,2),5)_" "_$P(MODZ,U,1)
12 I DZ S MODZ=$G(^LAB(61.4,+DZ,0)),MODZ=$P(MODZ,U,2)_" "_$P(MODZ,U,1)
13 D DT
14 W $E(XNM,1,20),?22,$E(XSN,1,6),?29,XDT,?44,LRSS
15 I $D(^ONCO(165.5,"C",D0)) D DLC^ONCOCRF,DATEOT^ONCOES W ?54,X
16 W !
17 W "Topography:",?12,TO,!
18 W:MO "Morphology:",?13,MODZ
19 W:DZ "Disease:",?15,MODZ
20 D SDD^ONCOCOM
21 W !,"-------------------------------------------------------------------------------"
22 W ! G EX
23 ;
24PTF ;PTF CASEFINDING REPORT (160,54)
25 D GET G EX:O2=""
26 S SR=$P(O2,U,3) G EX:$E(SR,1)'="P"
27 S IC=$G(^ICD9(+$P(O2,U,9),0)) G EX:IC=""
28 S XDT=+$P(O2,U,8)
29 D DT
30 S XDD=XDT,XDT=$P(O2,U,1)
31 D DT
32 W $E(XNM,1,20),?22,XSN,?29,XDT_" - "_XDD,!
33 W "Diagnosis:",?11,$P(IC,U,1),?19,$P(IC,U,3),!!
34 G LST
35 ;
36RAD ;RADIOLOGY CASEFINDING REPORT (160,58)
37 D GET G EX:O2=""
38 S SR=$P(O2,U,3) G EX:$E(SR,1)'="R"
39 S XDT=$P(O2,U,1),RAD=$P($G(^RAMIS(71,+$P(O2,U,7),0)),U) G EX:RAD=""
40 D DT
41 W $E(XNM,1,29),?31,XSN,?38,XDT,?50,$E(RAD,1,30)
42 G LST
43 ;
44GET ;Set variables
45 S XD0=$G(^ONCO(160,D0,0)),GLO="" I XD0="" Q
46 S LRDFN=$P(XD0,U,2)
47 S VPR=$P(XD0,U)
48 S GLO=U_$P(VPR,";",2)_$P(VPR,";"),GL0=GLO_",0)"
49 S XPI=$G(@GL0),XNM=$P(XPI,U),SN=$P(XPI,U,9),XSN=$E(XNM,1)_$E(SN,6,9)
50 S O2="" I $D(^ONCO(160,D0,"SUS","C",DUZ(2))) D K SUSIEN
51 .S SUSIEN=$O(^ONCO(160,D0,"SUS","C",DUZ(2),0))
52 .S O2=^ONCO(160,D0,"SUS",SUSIEN,0)
53 Q
54 ;
55DT ;Format date
56 S XDT=$E(XDT,4,5)_"/"_$E(XDT,6,7)_"/"_($E(XDT,1,3)+1700)
57 Q
58 ;
59LST ;Display DATE LAST CONTACT (160,16) and primary list
60 G EX:'$D(^ONCO(165.5,"C",D0))
61 D DLC^ONCOCRF,DATEOT^ONCOES
62 W !!?25,"Last Contact: ",X
63 D SDD^ONCOCOM
64 W ! G EX
65 ;
66EX ;Exit
67 S X=""
68 K GLO,LRDFN,LRI,LRSS,MO,MX,SN,TO,VPR,XDT,XD0,XMO,XM1,XNM,XPI,XSN
69 Q
Note: See TracBrowser for help on using the repository browser.