Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCOCOC

ONCOCOC.m

Go to the documentation of this file.
  1. ONCOCOC ;Hines OIFO/GWB - COMPUTED FIELDS FOR CASEFINDING REPORTS ;05/25/00
  1. ;;2.2;ONCOLOGY;**1,7**;Jul 31, 2013;Build 5
  1. ;
  1. LAB ;LAB CASEFINDING REPORT (160,53)
  1. N X
  1. D GET G EX:O2=""
  1. S SR=$P(O2,U,3) G EX:$E(SR,1)'="L"
  1. S SR=$E(SR,2),LRSS=$S(SR="S":"SP",SR="C":"CY",SR="E":"EM",1:"AU")
  1. S XDT=$P(O2,U,1),MO=$P(O2,U,5),TO=$P(O2,U,6),DZ=$P(O2,U,14)
  1. S TO=$S(TO="":"None",1:"T-"_$P(^LAB(61,+TO,0),U,2)_" "_$P(^LAB(61,+TO,0),U,1))
  1. S MODZ="None"
  1. 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)
  1. I DZ S MODZ=$G(^LAB(61.4,+DZ,0)),MODZ=$P(MODZ,U,2)_" "_$P(MODZ,U,1)
  1. D DT
  1. W $E(XNM,1,20),?22,$E(XSN,1,6),?29,XDT,?44,LRSS
  1. I $D(^ONCO(165.5,"C",D0)) D DLC^ONCOCRF,DATEOT^ONCOES W ?54,X
  1. W !
  1. W "Topography:",?12,TO,!
  1. W:MO "Morphology:",?13,MODZ
  1. W:DZ "Disease:",?15,MODZ
  1. D SDD^ONCOCOM
  1. W !,"-------------------------------------------------------------------------------"
  1. W ! G EX
  1. ;
  1. PTF ;PTF CASEFINDING REPORT (160,54)
  1. N ONCIC
  1. D GET G EX:O2=""
  1. S SR=$P(O2,U,3) G EX:$E(SR,1)'="P"
  1. S ONCIC=$$GET1^DIQ(80,+$P(O2,U,9),.01,"I")
  1. S IC=$$ICDDX^ICDEXC(ONCIC) G EX:+IC=-1
  1. S XDT=+$P(O2,U,8)
  1. D DT
  1. S XDD=XDT,XDT=$P(O2,U,1)
  1. D DT
  1. W $E(XNM,1,20),?22,XSN,?29,XDT_" - "_XDD,!
  1. W "Diagnosis:",?11,$P(IC,U,2),?19,$P(IC,U,4),!!
  1. G LST
  1. ;
  1. RAD ;RADIOLOGY CASEFINDING REPORT (160,58)
  1. D GET G EX:O2=""
  1. S SR=$P(O2,U,3) G EX:$E(SR,1)'="R"
  1. S XDT=$P(O2,U,1),RAD=$P($G(^RAMIS(71,+$P(O2,U,7),0)),U) G EX:RAD=""
  1. D DT
  1. ;B "L"
  1. W $E(XNM,1,29),?31,XSN,?38,XDT,?50,$E(RAD,1,30)
  1. G LST
  1. ;
  1. GET ;Set variables
  1. S XD0=$G(^ONCO(160,D0,0)),GLO="" I XD0="" Q
  1. S LRDFN=$P(XD0,U,2)
  1. S VPR=$P(XD0,U)
  1. S GLO=U_$P(VPR,";",2)_$P(VPR,";"),GL0=GLO_",0)"
  1. S XPI=$G(@GL0),XNM=$P(XPI,U),SN=$P(XPI,U,9),XSN=$E(XNM,1)_$E(SN,6,9)
  1. S O2="" I $D(^ONCO(160,D0,"SUS","C",DUZ(2))) D K SUSIEN
  1. .S SUSIEN=$O(^ONCO(160,D0,"SUS","C",DUZ(2),0))
  1. .S O2=^ONCO(160,D0,"SUS",SUSIEN,0)
  1. Q
  1. ;
  1. DT ;Format date
  1. S XDT=$E(XDT,4,5)_"/"_$E(XDT,6,7)_"/"_($E(XDT,1,3)+1700)
  1. Q
  1. ;
  1. LST ;Display DATE LAST CONTACT (160,16) and primary list
  1. G EX:'$D(^ONCO(165.5,"C",D0))
  1. D DLC^ONCOCRF,DATEOT^ONCOES
  1. W !!?25,"Last Contact: ",X
  1. D SDD^ONCOCOM
  1. W ! G EX
  1. ;
  1. EX ;Exit
  1. S X=""
  1. K DZ,GL0,GLO,IC,LRDFN,LRSS,MO,MODZ,O2,RAD,SN,SR,TO,VPR,XDT,XD0,XDD,XMO
  1. K XM1,XNM,XPI,XSN
  1. Q