ONCPMC ;Hines OIFO/GWB - COLON AND RECTUM Performance Measures ;09/26/11
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
N DIE,DNT,I,X,Y
S DIE="^ONCO(165.5,",DA=ONCONUM
S DNT=$P($G(^ONCO(165.5,ONCONUM,2.1)),U,11)
I DNT'="" D
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,13)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,4)=8
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,4)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,4)=0
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,8)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,8)=0
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,9)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,9)=0
.S:$P($G(^ONCO(165.5,ONCONUM,"BLA2")),U,41)="" $P(^ONCO(165.5,ONCONUM,"BLA2"),U,41)=0
.S:$P($G(^ONCO(165.5,ONCONUM,3)),U,29)="" $P(^ONCO(165.5,ONCONUM,3),U,29)=0
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,12)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,12)=0
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,10)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,10)=0
K DIR D HEAD
S DR=""
S DR(1,165.5,1)="270"
S DR(1,165.5,2)="254"
S DR(1,165.5,3)="271"
S DR(1,165.5,4)="258"
S DR(1,165.5,5)="259"
S DR(1,165.5,6)="272"
S DR(1,165.5,7)="382"
S DR(1,165.5,8)="127"
S DR(1,165.5,9)="262"
S DR(1,165.5,10)="260"
S DR(1,165.5,11)="273"
S DR(1,165.5,12)="274"
D ^DIE
W !
K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) OUT="Y"
Q
;
HEAD ;PCE header
W @IOF
W DASHES,!
W ?1,PATNAM,?SITTAB,SITEGP
W !
W ?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
W !,DASHES
S HDL=$L("Performance Measures for Colorectal Cancer")
S TAB=(80-HDL)\2,TAB=TAB-1
W !,?TAB,"Performance Measures for Colorectal Cancer"
W !,DASHES
N DI,DIC,DR,DA,DIQ,ONC
S DA=ONCONUM
S DIC="^ONCO(165.5,"
S DR="270:274;254;258;259;260;382;127;262"
S DIQ="ONC" D EN^DIQ1
F I=270,254,271,258,259,382,127,262,260,273,274 S X=ONC(165.5,ONCONUM,I) D UCASE S ONC(165.5,ONCONUM,I)=X
W !," Preop obstructing lesion......: ",ONC(165.5,ONCONUM,270)
W !," Intent of Surgery.............: ",ONC(165.5,ONCONUM,254)
W !," Oncology referral.............: ",ONC(165.5,ONCONUM,271)
W !," Intent of Chemotherapy........: ",ONC(165.5,ONCONUM,258)
W !," Type of Chemotherapy..........: ",ONC(165.5,ONCONUM,259)
W !," Date Chemotherapy recommended.: ",ONC(165.5,ONCONUM,272)
W !," Reason Chemotherapy Stopped...: ",ONC(165.5,ONCONUM,382)
W !," Intent of Radiation...........: ",ONC(165.5,ONCONUM,127)
W !," Multimodality Radiation Type..: ",ONC(165.5,ONCONUM,262)
W !," Reason Radiation Stopped......: ",ONC(165.5,ONCONUM,260)
W !," Anti-EGFR MoAB Therapy........: ",ONC(165.5,ONCONUM,273)
W !," Perirectal LN Involvement.....: ",ONC(165.5,ONCONUM,274)
W !,DASHES
Q
;
UCASE ;Mixed case to uppercase conversion
S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q
;
EXIT ;Kill variables and exit
K HDL,ONCONUM,OUT,TAB
K DIC,DIR,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,X,Y
Q
;
CLEANUP ;Cleanup
K DASHES,PATNAM,SITEGP,SITTAB,SSN,TOPCOD,TOPNAM,TOPTAB
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCPMC 2917 printed Apr 09, 2024@21:26:54 Page 2
ONCPMC ;Hines OIFO/GWB - COLON AND RECTUM Performance Measures ;09/26/11
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
+3 NEW DIE,DNT,I,X,Y
+4 SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
+5 SET DNT=$PIECE($GET(^ONCO(165.5,ONCONUM,2.1)),U,11)
+6 IF DNT'=""
Begin DoDot:1
+7 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,13)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,4)=8
+8 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,4)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,4)=0
+9 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,8)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,8)=0
+10 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,9)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,9)=0
+11 if $PIECE($GET(^ONCO(165.5,ONCONUM,"BLA2")),U,41)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,41)=0
+12 if $PIECE($GET(^ONCO(165.5,ONCONUM,3)),U,29)=""
SET $PIECE(^ONCO(165.5,ONCONUM,3),U,29)=0
+13 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,12)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,12)=0
+14 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,10)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,10)=0
End DoDot:1
+15 KILL DIR
DO HEAD
+16 SET DR=""
+17 SET DR(1,165.5,1)="270"
+18 SET DR(1,165.5,2)="254"
+19 SET DR(1,165.5,3)="271"
+20 SET DR(1,165.5,4)="258"
+21 SET DR(1,165.5,5)="259"
+22 SET DR(1,165.5,6)="272"
+23 SET DR(1,165.5,7)="382"
+24 SET DR(1,165.5,8)="127"
+25 SET DR(1,165.5,9)="262"
+26 SET DR(1,165.5,10)="260"
+27 SET DR(1,165.5,11)="273"
+28 SET DR(1,165.5,12)="274"
+29 DO ^DIE
+30 WRITE !
+31 KILL DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
SET OUT="Y"
+32 QUIT
+33 ;
HEAD ;PCE header
+1 WRITE @IOF
+2 WRITE DASHES,!
+3 WRITE ?1,PATNAM,?SITTAB,SITEGP
+4 WRITE !
+5 WRITE ?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
+6 WRITE !,DASHES
+7 SET HDL=$LENGTH("Performance Measures for Colorectal Cancer")
+8 SET TAB=(80-HDL)\2
SET TAB=TAB-1
+9 WRITE !,?TAB,"Performance Measures for Colorectal Cancer"
+10 WRITE !,DASHES
+11 NEW DI,DIC,DR,DA,DIQ,ONC
+12 SET DA=ONCONUM
+13 SET DIC="^ONCO(165.5,"
+14 SET DR="270:274;254;258;259;260;382;127;262"
+15 SET DIQ="ONC"
DO EN^DIQ1
+16 FOR I=270,254,271,258,259,382,127,262,260,273,274
SET X=ONC(165.5,ONCONUM,I)
DO UCASE
SET ONC(165.5,ONCONUM,I)=X
+17 WRITE !," Preop obstructing lesion......: ",ONC(165.5,ONCONUM,270)
+18 WRITE !," Intent of Surgery.............: ",ONC(165.5,ONCONUM,254)
+19 WRITE !," Oncology referral.............: ",ONC(165.5,ONCONUM,271)
+20 WRITE !," Intent of Chemotherapy........: ",ONC(165.5,ONCONUM,258)
+21 WRITE !," Type of Chemotherapy..........: ",ONC(165.5,ONCONUM,259)
+22 WRITE !," Date Chemotherapy recommended.: ",ONC(165.5,ONCONUM,272)
+23 WRITE !," Reason Chemotherapy Stopped...: ",ONC(165.5,ONCONUM,382)
+24 WRITE !," Intent of Radiation...........: ",ONC(165.5,ONCONUM,127)
+25 WRITE !," Multimodality Radiation Type..: ",ONC(165.5,ONCONUM,262)
+26 WRITE !," Reason Radiation Stopped......: ",ONC(165.5,ONCONUM,260)
+27 WRITE !," Anti-EGFR MoAB Therapy........: ",ONC(165.5,ONCONUM,273)
+28 WRITE !," Perirectal LN Involvement.....: ",ONC(165.5,ONCONUM,274)
+29 WRITE !,DASHES
+30 QUIT
+31 ;
UCASE ;Mixed case to uppercase conversion
+1 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 QUIT
+3 ;
EXIT ;Kill variables and exit
+1 KILL HDL,ONCONUM,OUT,TAB
+2 KILL DIC,DIR,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,X,Y
+3 QUIT
+4 ;
CLEANUP ;Cleanup
+1 KILL DASHES,PATNAM,SITEGP,SITTAB,SSN,TOPCOD,TOPNAM,TOPTAB
+2 QUIT
