ONCOCOML ;Hines OIFO/GWB - Display abstract summary; 07/13/00
;;2.2;ONCOLOGY;**1,4**;Jul 31, 2013;Build 5
;
N ACS,TOP,LTS,DDX,ABS,DIV
S ACS=$$GET1^DIQ(165.5,XD1,.061)
S TOP=$$GET1^DIQ(165.5,XD1,20)
S LTS=$$GET1^DIQ(165.5,XD1,95,"I")
S:LTS'="" LTS=$$GET1^DIQ(164.42,LTS,2)
S DDX=$$GET1^DIQ(165.5,XD1,3)
S ABS=$$GET1^DIQ(165.5,XD1,91)
S DIV=$$GET1^DIQ(165.5,XD1,2000,"I")
S:DIV'="" DIV=$$GET1^DIQ(4,DIV,99)
S LIN=" ------------- -------------------- ----------------- ---------- ---- ----"
I $G(J)=1 D
.W !?1,"Acc/Sequence",?16,"Primary Site",?38,"Last Tumor Status",?57,"Date Dx",?69,"Stat",?75,"Div"
.W !,LIN,!
W ?1,ACS,?16,$E(TOP,1,20),?38,LTS,?57,DDX,?69,$E(ABS,1,3),?75,DIV,!
Q
;
DIS2 ;
N PID,NAM,ACS,TOP,DDX,DIV
S PID=$$GET1^DIQ(165.5,ONCXD1,61)
S NAM=$$GET1^DIQ(165.5,ONCXD1,.02)
S ACS=$$GET1^DIQ(165.5,ONCXD1,.061)
S TOP=$$GET1^DIQ(165.5,ONCXD1,20)
S DDX=$$GET1^DIQ(165.5,ONCXD1,3)
S DIV=$$GET1^DIQ(165.5,ONCXD1,2000,"I")
S:DIV'="" DIV=$$GET1^DIQ(4,DIV,99)
W !?1,PID,?8,$E(NAM,1,18),?27,ACS,?42,$E(TOP,1,21),?64,DDX,?76,DIV
Q
;
HDR ;
W !?1,"PID",?8,"Name",?27,"Acc/Sequence",?42,"Primary Site",?64,"Date Dx",?76,"Div"
W !?1,"-----",?8,"-----------------",?27,"-------------",?42,"--------------------",?64,"----------",?76,"---"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOCOML 1309 printed Nov 22, 2024@17:34:42 Page 2
ONCOCOML ;Hines OIFO/GWB - Display abstract summary; 07/13/00
+1 ;;2.2;ONCOLOGY;**1,4**;Jul 31, 2013;Build 5
+2 ;
+3 NEW ACS,TOP,LTS,DDX,ABS,DIV
+4 SET ACS=$$GET1^DIQ(165.5,XD1,.061)
+5 SET TOP=$$GET1^DIQ(165.5,XD1,20)
+6 SET LTS=$$GET1^DIQ(165.5,XD1,95,"I")
+7 if LTS'=""
SET LTS=$$GET1^DIQ(164.42,LTS,2)
+8 SET DDX=$$GET1^DIQ(165.5,XD1,3)
+9 SET ABS=$$GET1^DIQ(165.5,XD1,91)
+10 SET DIV=$$GET1^DIQ(165.5,XD1,2000,"I")
+11 if DIV'=""
SET DIV=$$GET1^DIQ(4,DIV,99)
+12 SET LIN=" ------------- -------------------- ----------------- ---------- ---- ----"
+13 IF $GET(J)=1
Begin DoDot:1
+14 WRITE !?1,"Acc/Sequence",?16,"Primary Site",?38,"Last Tumor Status",?57,"Date Dx",?69,"Stat",?75,"Div"
+15 WRITE !,LIN,!
End DoDot:1
+16 WRITE ?1,ACS,?16,$EXTRACT(TOP,1,20),?38,LTS,?57,DDX,?69,$EXTRACT(ABS,1,3),?75,DIV,!
+17 QUIT
+18 ;
DIS2 ;
+1 NEW PID,NAM,ACS,TOP,DDX,DIV
+2 SET PID=$$GET1^DIQ(165.5,ONCXD1,61)
+3 SET NAM=$$GET1^DIQ(165.5,ONCXD1,.02)
+4 SET ACS=$$GET1^DIQ(165.5,ONCXD1,.061)
+5 SET TOP=$$GET1^DIQ(165.5,ONCXD1,20)
+6 SET DDX=$$GET1^DIQ(165.5,ONCXD1,3)
+7 SET DIV=$$GET1^DIQ(165.5,ONCXD1,2000,"I")
+8 if DIV'=""
SET DIV=$$GET1^DIQ(4,DIV,99)
+9 WRITE !?1,PID,?8,$EXTRACT(NAM,1,18),?27,ACS,?42,$EXTRACT(TOP,1,21),?64,DDX,?76,DIV
+10 QUIT
+11 ;
HDR ;
+1 WRITE !?1,"PID",?8,"Name",?27,"Acc/Sequence",?42,"Primary Site",?64,"Date Dx",?76,"Div"
+2 WRITE !?1,"-----",?8,"-----------------",?27,"-------------",?42,"--------------------",?64,"----------",?76,"---"
+3 QUIT
