ONCPCI ;HINES OIFO/GWB - Patient ID/Cancer ID screen display ;09/22/11
;;2.2;ONCOLOGY;**1,9,10,20,21**;Jul 31, 2013;Build 6
;
PI ;Patient Identification
K DASH S $P(DASH,"-",80)="-"
N DI,DIC,DR,DA,DIQ,ONC,TM1,TM2,TM3,DOTS1,DOTS2,DOTS3
S DIC="^ONCO(165.5,"
S DR=".03;1.2;2;2.1;2.2;2.3;2.4;8;8.1;8.2;9;10;11;16;18;147"
S DA=D0,DIQ="ONC" D EN^DIQ1
F I=.03,1.2,2,2.1,2.2,2.3,2.4,8,8.1,8.2,9,10,11,16,18 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
W !," Reporting Facility...........: ",ONC(165.5,D0,.03)
W !," Marital Status at Dx.........: ",ONC(165.5,D0,11)
W !," Patient Address at Dx........: ",ONC(165.5,D0,8)
W !," Patient Address at Dx - Supp.: ",ONC(165.5,D0,8.2)
W !," City/town at Dx..............: ",ONC(165.5,D0,8.1)
W !," State at Dx..................: ",ONC(165.5,D0,16)
W !," Postal Code at Dx............: ",ONC(165.5,D0,9)
W !," County at Dx.................: ",ONC(165.5,D0,10)
W !," Census Tract.................: ",ONC(165.5,D0,147)
I DATEDX>3061231 D
.W !," Managing Physician...........: ",ONC(165.5,D0,2.2)
W !," Following Physician..........: ",ONC(165.5,D0,2.1)
W !," Primary Surgeon..............: ",ONC(165.5,D0,2)
W !," Physician #3.................: ",ONC(165.5,D0,2.3)
W !," Physician #4.................: ",ONC(165.5,D0,2.4)
W !," Primary Payer at Dx..........: ",ONC(165.5,D0,18)
W !," Type of Reporting Source.....: ",$P($G(^ONCO(165.5,D0,0)),"^",10)," ",ONC(165.5,D0,1.2)
W !,DASH
K DASH,I,X
Q
;
CI ;Cancer Identification
I DATEDX>3171231 D ^ONCSCHMA
K DASH S $P(DASH,"-",80)="-"
N DI,DIC,DR,DA,DIQ,ONC,TM1,TM2,TM3,DOTS1,DOTS2,DOTS3
S DIC="^ONCO(165.5,"
S DR=".04;.06;6;7;155;3;28;22;22.1;22.3;24:24.5;26;25.1;25.2;25.3;83;623;684;120;121;1010;5;171;172;173;21;96;102;156;159;193;194;195;196;233;237;237.1;238;250;3926;3927"
S DA=D0,DIQ="ONC" D EN^DIQ1
F I=.04,28,24,25.1,25.2,25.3,26,83,120,684,1010,5,21,102,159,194,24.1,24.2,24.3,24.4,24.5,233,237,237.1,238,3926,3927 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
S COC=$E($$GET1^DIQ(165.5,D0,.04,"E"),1,2)
S TM1=$$PRINT^ONCOTM(D0,1)
K DOTS1 S $P(DOTS1,".",25-$L(TM1))="."
S TM2=$$PRINT^ONCOTM(D0,2)
K DOTS2 S $P(DOTS2,".",25-$L(TM2))="."
S TM3=$$PRINT^ONCOTM(D0,3)
K DOTS3 S $P(DOTS3,".",25-$L(TM3))="."
S TXT=ONC(165.5,D0,.04),LEN=48 D TXT
W !," Class of Case................: ",TXT1 W:TXT2'="" !,?35,TXT2
; I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14) D
;.W !," Date of First Symptoms.......: ",ONC(165.5,D0,171)
;.W !," Date Workup Ordered/Started..: ",ONC(165.5,D0,172)," ",ONC(165.5,D0,173)
S TXT=ONC(165.5,D0,6),LEN=46 D TXT
W !," Facility referred from.......: ",TXT1 W:TXT2'="" !,?32,TXT2
S TXT=ONC(165.5,D0,7),LEN=46 D TXT
W !," Facility referred to.........: ",TXT1 W:TXT2'="" !,?32,TXT2
W !," Fee Basis....................: ",ONC(165.5,D0,237)
I ONC(165.5,D0,237)="YES",$G(ONC(165.5,D0,237.1))'="" W " (",ONC(165.5,D0,237.1),")"
W !," Date of First Contact........: ",ONC(165.5,D0,155)
W !," Date Dx......................: ",ONC(165.5,D0,3)
I DATEDX>3091231 D
.W !," Inpatient Status.............: ",ONC(165.5,D0,233)
I DATEDX>3061231,DATEDX<3140000 D
.W !," Ambiguous Terminology Dx.....: ",ONC(165.5,D0,159)
.W !," Date of Conclusive Dx........: ",ONC(165.5,D0,193)
S TXT=ONC(165.5,D0,5),LEN=46 D TXT
W !," Dx Facility..................: ",TXT1 W:TXT2'="" !,?32,TXT2
W:ONC(165.5,D0,238)'="" !," Outside Slides Reviewed......: ",ONC(165.5,D0,238)
S HIST=$$HIST^ONCFUNC(D0,.HSTFLD,.HISTNAM)
S TXT=ONC(165.5,D0,HSTFLD),LEN=46 D TXT
W !," Histology/Behavior Code......: ",ONC(165.5,D0,22.1)_" "_TXT1 W:TXT2'="" !,?32,TXT2
W !," Sequence Number..............: ",ONC(165.5,D0,.06)
W:$G(TOP)=67619 !," Gleason Score (Clinical).....: ",ONC(165.5,D0,623)
W:$G(TOP)=67619 !," Gleason Score (Pathologic)...: ",ONC(165.5,D0,250)
W:$G(TOP)=67619 !," PSA..........................: ",ONC(165.5,D0,96)," ",ONC(165.5,D0,684)
W:$G(TOP)=67619 !," DRE +/-......................: ",ONC(165.5,D0,156)," ",ONC(165.5,D0,102)
S TXT=ONC(165.5,D0,28),LEN=46 D TXT
W !," Laterality...................: ",TXT1 W:TXT2'="" !,?32,TXT2
W:DATEDX<3180000 !," Grade/Differentiation........: ",ONC(165.5,D0,24)
I DATEDX>3091231!(DATEDX<3140000) D
.W:ONC(165.5,D0,24.1)'="" !," Grade Path System............: ",ONC(165.5,D0,24.1)
.W:ONC(165.5,D0,24.2)'="" !," Grade Path Value.............: ",ONC(165.5,D0,24.2)
I DATEDX>3171231 D
.W:ONC(165.5,D0,3926)'="" !," Schema Discriminator 1.......: ",ONC(165.5,D0,3926)
.W:ONC(165.5,D0,3927)'="" !," Schema Discriminator 2.......: ",ONC(165.5,D0,3927)
.I ONC(165.5,D0,24.3)'="" S ONCDGSX=ONC(165.5,D0,24.3) D DSP^ONCSCHMG S LEN=47 D TXT W !," Grade Clinical...............: ",TXT1 W:TXT2'="" !,?35,$E(TXT2,1,45)
.I ONC(165.5,D0,24.4)'="" S ONCDGSX=ONC(165.5,D0,24.4) D DSP^ONCSCHMG S LEN=47 D TXT W !," Grade Pathological...........: ",TXT1 W:TXT2'="" !,?35,$E(TXT2,1,45)
.I ONC(165.5,D0,24.5)'="" S ONCDGSX=ONC(165.5,D0,24.5) D DSP^ONCSCHMG S LEN=47 D TXT W !," Grade Post-Therapy...........: ",TXT1 W:TXT2'="" !,?35,$E(TXT2,1,45)
I DATEDX>3061231,DATEDX<3140000 D
.W !," Mult Tum Rpt as One Prim.....: ",ONC(165.5,D0,194)
.W !," Date of Multiple Tumors......: ",ONC(165.5,D0,195)
.W !," Multiplicity Counter.........: ",ONC(165.5,D0,196)
W !," AFIP/JPC submission..........: ",ONC(165.5,D0,83)
W !," Diagnostic Confirmation......: ",ONC(165.5,D0,26)
;W:($$GET1^DIQ(165.5,D0,.01,"E")="LIVER")!($G(TOP)=67220) !," Hepatitis C..................: ",ONC(165.5,D0,1010)
;I DATEDX<3030000 D
;.W !," ",TM1,DOTS1,"....: ",ONC(165.5,D0,25.1)
;.W !," ",TM2,DOTS2,"....: ",ONC(165.5,D0,25.2)
;.W !," ",TM3,DOTS3,"....: ",ONC(165.5,D0,25.3)
W !," Presentation at Cancer Conf..: ",ONC(165.5,D0,121)," ",ONC(165.5,D0,120)
W !," Casefinding Source...........: ",ONC(165.5,D0,21)
W !,DASH
K DASH,HIST,HSTFLD,HISTNAM,LEN,LOS,NOP,TXT,TXT1,TXT2,X
Q
;
TXT ;Text formatting
S (TXT1,TXT2)="",LOS=$L(TXT) I LOS<LEN S TXT1=TXT Q
S NOP=$L($E(TXT,1,LEN)," ")
S TXT1=$P(TXT," ",1,NOP-1),TXT2=$P(TXT," ",NOP,999)
Q
;
UCASE ;Mixed case to uppercase conversion
S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q
;
CLEANUP ;Cleanup
K COC,D0,DATEDX,TOP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCPCI 6280 printed Sep 23, 2025@20:03:09 Page 2
ONCPCI ;HINES OIFO/GWB - Patient ID/Cancer ID screen display ;09/22/11
+1 ;;2.2;ONCOLOGY;**1,9,10,20,21**;Jul 31, 2013;Build 6
+2 ;
PI ;Patient Identification
+1 KILL DASH
SET $PIECE(DASH,"-",80)="-"
+2 NEW DI,DIC,DR,DA,DIQ,ONC,TM1,TM2,TM3,DOTS1,DOTS2,DOTS3
+3 SET DIC="^ONCO(165.5,"
+4 SET DR=".03;1.2;2;2.1;2.2;2.3;2.4;8;8.1;8.2;9;10;11;16;18;147"
+5 SET DA=D0
SET DIQ="ONC"
DO EN^DIQ1
+6 FOR I=.03,1.2,2,2.1,2.2,2.3,2.4,8,8.1,8.2,9,10,11,16,18
SET X=ONC(165.5,D0,I)
DO UCASE
SET ONC(165.5,D0,I)=X
+7 WRITE !," Reporting Facility...........: ",ONC(165.5,D0,.03)
+8 WRITE !," Marital Status at Dx.........: ",ONC(165.5,D0,11)
+9 WRITE !," Patient Address at Dx........: ",ONC(165.5,D0,8)
+10 WRITE !," Patient Address at Dx - Supp.: ",ONC(165.5,D0,8.2)
+11 WRITE !," City/town at Dx..............: ",ONC(165.5,D0,8.1)
+12 WRITE !," State at Dx..................: ",ONC(165.5,D0,16)
+13 WRITE !," Postal Code at Dx............: ",ONC(165.5,D0,9)
+14 WRITE !," County at Dx.................: ",ONC(165.5,D0,10)
+15 WRITE !," Census Tract.................: ",ONC(165.5,D0,147)
+16 IF DATEDX>3061231
Begin DoDot:1
+17 WRITE !," Managing Physician...........: ",ONC(165.5,D0,2.2)
End DoDot:1
+18 WRITE !," Following Physician..........: ",ONC(165.5,D0,2.1)
+19 WRITE !," Primary Surgeon..............: ",ONC(165.5,D0,2)
+20 WRITE !," Physician #3.................: ",ONC(165.5,D0,2.3)
+21 WRITE !," Physician #4.................: ",ONC(165.5,D0,2.4)
+22 WRITE !," Primary Payer at Dx..........: ",ONC(165.5,D0,18)
+23 WRITE !," Type of Reporting Source.....: ",$PIECE($GET(^ONCO(165.5,D0,0)),"^",10)," ",ONC(165.5,D0,1.2)
+24 WRITE !,DASH
+25 KILL DASH,I,X
+26 QUIT
+27 ;
CI ;Cancer Identification
+1 IF DATEDX>3171231
DO ^ONCSCHMA
+2 KILL DASH
SET $PIECE(DASH,"-",80)="-"
+3 NEW DI,DIC,DR,DA,DIQ,ONC,TM1,TM2,TM3,DOTS1,DOTS2,DOTS3
+4 SET DIC="^ONCO(165.5,"
+5 SET DR=".04;.06;6;7;155;3;28;22;22.1;22.3;24:24.5;26;25.1;25.2;25.3;83;623;684;120;121;1010;5;171;172;173;21;96;102;156;159;193;194;195;196;233;237;237.1;238;250;3926;3927"
+6 SET DA=D0
SET DIQ="ONC"
DO EN^DIQ1
+7 FOR I=.04,28,24,25.1,25.2,25.3,26,83,120,684,1010,5,21,102,159,194,24.1,24.2,24.3,24.4,24.5,233,237,237.1,238,3926,3927
SET X=ONC(165.5,D0,I)
DO UCASE
SET ONC(165.5,D0,I)=X
+8 SET COC=$EXTRACT($$GET1^DIQ(165.5,D0,.04,"E"),1,2)
+9 SET TM1=$$PRINT^ONCOTM(D0,1)
+10 KILL DOTS1
SET $PIECE(DOTS1,".",25-$LENGTH(TM1))="."
+11 SET TM2=$$PRINT^ONCOTM(D0,2)
+12 KILL DOTS2
SET $PIECE(DOTS2,".",25-$LENGTH(TM2))="."
+13 SET TM3=$$PRINT^ONCOTM(D0,3)
+14 KILL DOTS3
SET $PIECE(DOTS3,".",25-$LENGTH(TM3))="."
+15 SET TXT=ONC(165.5,D0,.04)
SET LEN=48
DO TXT
+16 WRITE !," Class of Case................: ",TXT1
if TXT2'=""
WRITE !,?35,TXT2
+17 ; I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14) D
+18 ;.W !," Date of First Symptoms.......: ",ONC(165.5,D0,171)
+19 ;.W !," Date Workup Ordered/Started..: ",ONC(165.5,D0,172)," ",ONC(165.5,D0,173)
+20 SET TXT=ONC(165.5,D0,6)
SET LEN=46
DO TXT
+21 WRITE !," Facility referred from.......: ",TXT1
if TXT2'=""
WRITE !,?32,TXT2
+22 SET TXT=ONC(165.5,D0,7)
SET LEN=46
DO TXT
+23 WRITE !," Facility referred to.........: ",TXT1
if TXT2'=""
WRITE !,?32,TXT2
+24 WRITE !," Fee Basis....................: ",ONC(165.5,D0,237)
+25 IF ONC(165.5,D0,237)="YES"
IF $GET(ONC(165.5,D0,237.1))'=""
WRITE " (",ONC(165.5,D0,237.1),")"
+26 WRITE !," Date of First Contact........: ",ONC(165.5,D0,155)
+27 WRITE !," Date Dx......................: ",ONC(165.5,D0,3)
+28 IF DATEDX>3091231
Begin DoDot:1
+29 WRITE !," Inpatient Status.............: ",ONC(165.5,D0,233)
End DoDot:1
+30 IF DATEDX>3061231
IF DATEDX<3140000
Begin DoDot:1
+31 WRITE !," Ambiguous Terminology Dx.....: ",ONC(165.5,D0,159)
+32 WRITE !," Date of Conclusive Dx........: ",ONC(165.5,D0,193)
End DoDot:1
+33 SET TXT=ONC(165.5,D0,5)
SET LEN=46
DO TXT
+34 WRITE !," Dx Facility..................: ",TXT1
if TXT2'=""
WRITE !,?32,TXT2
+35 if ONC(165.5,D0,238)'=""
WRITE !," Outside Slides Reviewed......: ",ONC(165.5,D0,238)
+36 SET HIST=$$HIST^ONCFUNC(D0,.HSTFLD,.HISTNAM)
+37 SET TXT=ONC(165.5,D0,HSTFLD)
SET LEN=46
DO TXT
+38 WRITE !," Histology/Behavior Code......: ",ONC(165.5,D0,22.1)_" "_TXT1
if TXT2'=""
WRITE !,?32,TXT2
+39 WRITE !," Sequence Number..............: ",ONC(165.5,D0,.06)
+40 if $GET(TOP)=67619
WRITE !," Gleason Score (Clinical).....: ",ONC(165.5,D0,623)
+41 if $GET(TOP)=67619
WRITE !," Gleason Score (Pathologic)...: ",ONC(165.5,D0,250)
+42 if $GET(TOP)=67619
WRITE !," PSA..........................: ",ONC(165.5,D0,96)," ",ONC(165.5,D0,684)
+43 if $GET(TOP)=67619
WRITE !," DRE +/-......................: ",ONC(165.5,D0,156)," ",ONC(165.5,D0,102)
+44 SET TXT=ONC(165.5,D0,28)
SET LEN=46
DO TXT
+45 WRITE !," Laterality...................: ",TXT1
if TXT2'=""
WRITE !,?32,TXT2
+46 if DATEDX<3180000
WRITE !," Grade/Differentiation........: ",ONC(165.5,D0,24)
+47 IF DATEDX>3091231!(DATEDX<3140000)
Begin DoDot:1
+48 if ONC(165.5,D0,24.1)'=""
WRITE !," Grade Path System............: ",ONC(165.5,D0,24.1)
+49 if ONC(165.5,D0,24.2)'=""
WRITE !," Grade Path Value.............: ",ONC(165.5,D0,24.2)
End DoDot:1
+50 IF DATEDX>3171231
Begin DoDot:1
+51 if ONC(165.5,D0,3926)'=""
WRITE !," Schema Discriminator 1.......: ",ONC(165.5,D0,3926)
+52 if ONC(165.5,D0,3927)'=""
WRITE !," Schema Discriminator 2.......: ",ONC(165.5,D0,3927)
+53 IF ONC(165.5,D0,24.3)'=""
SET ONCDGSX=ONC(165.5,D0,24.3)
DO DSP^ONCSCHMG
SET LEN=47
DO TXT
WRITE !," Grade Clinical...............: ",TXT1
if TXT2'=""
WRITE !,?35,$EXTRACT(TXT2,1,45)
+54 IF ONC(165.5,D0,24.4)'=""
SET ONCDGSX=ONC(165.5,D0,24.4)
DO DSP^ONCSCHMG
SET LEN=47
DO TXT
WRITE !," Grade Pathological...........: ",TXT1
if TXT2'=""
WRITE !,?35,$EXTRACT(TXT2,1,45)
+55 IF ONC(165.5,D0,24.5)'=""
SET ONCDGSX=ONC(165.5,D0,24.5)
DO DSP^ONCSCHMG
SET LEN=47
DO TXT
WRITE !," Grade Post-Therapy...........: ",TXT1
if TXT2'=""
WRITE !,?35,$EXTRACT(TXT2,1,45)
End DoDot:1
+56 IF DATEDX>3061231
IF DATEDX<3140000
Begin DoDot:1
+57 WRITE !," Mult Tum Rpt as One Prim.....: ",ONC(165.5,D0,194)
+58 WRITE !," Date of Multiple Tumors......: ",ONC(165.5,D0,195)
+59 WRITE !," Multiplicity Counter.........: ",ONC(165.5,D0,196)
End DoDot:1
+60 WRITE !," AFIP/JPC submission..........: ",ONC(165.5,D0,83)
+61 WRITE !," Diagnostic Confirmation......: ",ONC(165.5,D0,26)
+62 ;W:($$GET1^DIQ(165.5,D0,.01,"E")="LIVER")!($G(TOP)=67220) !," Hepatitis C..................: ",ONC(165.5,D0,1010)
+63 ;I DATEDX<3030000 D
+64 ;.W !," ",TM1,DOTS1,"....: ",ONC(165.5,D0,25.1)
+65 ;.W !," ",TM2,DOTS2,"....: ",ONC(165.5,D0,25.2)
+66 ;.W !," ",TM3,DOTS3,"....: ",ONC(165.5,D0,25.3)
+67 WRITE !," Presentation at Cancer Conf..: ",ONC(165.5,D0,121)," ",ONC(165.5,D0,120)
+68 WRITE !," Casefinding Source...........: ",ONC(165.5,D0,21)
+69 WRITE !,DASH
+70 KILL DASH,HIST,HSTFLD,HISTNAM,LEN,LOS,NOP,TXT,TXT1,TXT2,X
+71 QUIT
+72 ;
TXT ;Text formatting
+1 SET (TXT1,TXT2)=""
SET LOS=$LENGTH(TXT)
IF LOS<LEN
SET TXT1=TXT
QUIT
+2 SET NOP=$LENGTH($EXTRACT(TXT,1,LEN)," ")
+3 SET TXT1=$PIECE(TXT," ",1,NOP-1)
SET TXT2=$PIECE(TXT," ",NOP,999)
+4 QUIT
+5 ;
UCASE ;Mixed case to uppercase conversion
+1 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 QUIT
+3 ;
CLEANUP ;Cleanup
+1 KILL COC,D0,DATEDX,TOP
