Routine: ONCPMC

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"

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

UCASE ;Mixed case to uppercase conversion

 S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

EXIT ;Kill variables and exit

 K HDL,ONCONUM,OUT,TAB

 K DIC,DIR,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,X,Y

CLEANUP ;Cleanup

 K DASHES,PATNAM,SITEGP,SITTAB,SSN,TOPCOD,TOPNAM,TOPTAB

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCPMC   2917     printed  Mar 13, 2025@21:31:56                                                                                                                                                                                                      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

ONCPMC.m