ONCPML ;Hines OIFO/GWB - LUNG Performance Measures ;08/15/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,1)=1 $P(^ONCO(165.5,ONCONUM,"PM"),U,2)=8
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,3)="0000000" $P(^ONCO(165.5,ONCONUM,"PM"),U,4)=0
.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,5)="0000000" $P(^ONCO(165.5,ONCONUM,"PM"),U,6)="0000000"
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,7)=0 $P(^ONCO(165.5,ONCONUM,"PM"),U,8)=0
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,7)=0 $P(^ONCO(165.5,ONCONUM,"PM"),U,9)=0
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,7)=0 $P(^ONCO(165.5,ONCONUM,"PM"),U,11)=8
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,7)=0 $P(^ONCO(165.5,ONCONUM,"BLA2"),U,41)=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,8)=0 $P(^ONCO(165.5,ONCONUM,"PM"),U,9)=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,"PM")),U,11)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,11)=8
.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,3)),U,29)=0 $P(^ONCO(165.5,ONCONUM,"PM"),U,12)=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,3)),U,29)=0 $P(^ONCO(165.5,ONCONUM,"PM"),U,10)=0
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,10)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,10)=0
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,14)="0000000" $P(^ONCO(165.5,ONCONUM,"PM"),U,15)="0000000"
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,14)="0000000" $P(^ONCO(165.5,ONCONUM,"PM"),U,16)="0000000"
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,17)=0 $P(^ONCO(165.5,ONCONUM,"PM"),U,19)=9
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,17)=0 $P(^ONCO(165.5,ONCONUM,"PM"),U,18)=9
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,18)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,18)=8
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,19)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,19)=8
K DIR D HEAD
S DR=""
S DR(1,165.5,1)="251"
S DR(1,165.5,2)="252"
S DR(1,165.5,3)="253"
S DR(1,165.5,4)="254"
S DR(1,165.5,5)="255"
S DR(1,165.5,6)="256"
S DR(1,165.5,7)="257"
S DR(1,165.5,8)="258"
S DR(1,165.5,9)="259"
S DR(1,165.5,10)="261"
S DR(1,165.5,11)="382"
S DR(1,165.5,12)="127"
S DR(1,165.5,13)="262"
S DR(1,165.5,14)="260"
S DR(1,165.5,15)="264"
S DR(1,165.5,16)="265"
S DR(1,165.5,17)="266"
S DR(1,165.5,18)="267"
S DR(1,165.5,19)="268"
S DR(1,165.5,29)="269"
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 Non-Small Cell Lung Carcinoma")
S TAB=(80-HDL)\2,TAB=TAB-1
W !,?TAB,"Performance Measures for Non-Small Cell Lung Carcinoma"
W !,DASHES
N DI,DIC,DR,DA,DIQ,ONC
S DA=ONCONUM
S DIC="^ONCO(165.5,"
S DR="127;251:269;382"
S DIQ="ONC" D EN^DIQ1
F I=251,252,254,257,258,259,260,261,262,267,268,269,382,127 S X=ONC(165.5,ONCONUM,I) D UCASE S ONC(165.5,ONCONUM,I)=X
W !," NSLC Stage 1-3 Path LN Staging: ",ONC(165.5,ONCONUM,251)
W !," Reason for no LN Biopsy.......: ",ONC(165.5,ONCONUM,252)
W !," Date of Surgery Consult.......: ",ONC(165.5,ONCONUM,253)
W !," Intent of Surgery.............: ",ONC(165.5,ONCONUM,254)
W !," Date Oncology Consult Ordered.: ",ONC(165.5,ONCONUM,255)
W !," Date Oncology Consult Done....: ",ONC(165.5,ONCONUM,256)
W !," Chemotherapy Recommended......: ",ONC(165.5,ONCONUM,257)
W !," Intent of Chemotherapy........: ",ONC(165.5,ONCONUM,258)
W !," Type of Chemotherapy..........: ",ONC(165.5,ONCONUM,259)
W !," Doc for no Plat-based Chemo...: ",ONC(165.5,ONCONUM,261)
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 !," Date Hospice Consult Initiated: ",ONC(165.5,ONCONUM,264)
W !," Date Hospice Consult Completed: ",ONC(165.5,ONCONUM,265)
W !," Date Hospice Care Initiated...: ",ONC(165.5,ONCONUM,266)
W !," EGFR Mutation Testing.........: ",ONC(165.5,ONCONUM,267)
W !," EGFR Mutation 1...............: ",ONC(165.5,ONCONUM,268)
W !," EGFR Mutation 2...............: ",ONC(165.5,ONCONUM,269)
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[HONCPML 5010 printed Nov 22, 2024@17:37:13 Page 2
ONCPML ;Hines OIFO/GWB - LUNG Performance Measures ;08/15/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,1)=1
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,2)=8
+8 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,3)="0000000"
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,4)=0
+9 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,4)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,4)=0
+10 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,5)="0000000"
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,6)="0000000"
+11 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,7)=0
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,8)=0
+12 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,7)=0
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,9)=0
+13 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,7)=0
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,11)=8
+14 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,7)=0
SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,41)=0
+15 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,8)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,8)=0
+16 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,8)=0
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,9)=0
+17 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,9)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,9)=0
+18 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,11)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,11)=8
+19 if $PIECE($GET(^ONCO(165.5,ONCONUM,"BLA2")),U,41)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,41)=0
+20 if $PIECE($GET(^ONCO(165.5,ONCONUM,3)),U,29)=""
SET $PIECE(^ONCO(165.5,ONCONUM,3),U,29)=0
+21 if $PIECE($GET(^ONCO(165.5,ONCONUM,3)),U,29)=0
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,12)=0
+22 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,12)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,12)=0
+23 if $PIECE($GET(^ONCO(165.5,ONCONUM,3)),U,29)=0
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,10)=0
+24 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,10)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,10)=0
+25 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,14)="0000000"
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,15)="0000000"
+26 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,14)="0000000"
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,16)="0000000"
+27 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,17)=0
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,19)=9
+28 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,17)=0
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,18)=9
+29 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,18)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,18)=8
+30 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,19)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,19)=8
End DoDot:1
+31 KILL DIR
DO HEAD
+32 SET DR=""
+33 SET DR(1,165.5,1)="251"
+34 SET DR(1,165.5,2)="252"
+35 SET DR(1,165.5,3)="253"
+36 SET DR(1,165.5,4)="254"
+37 SET DR(1,165.5,5)="255"
+38 SET DR(1,165.5,6)="256"
+39 SET DR(1,165.5,7)="257"
+40 SET DR(1,165.5,8)="258"
+41 SET DR(1,165.5,9)="259"
+42 SET DR(1,165.5,10)="261"
+43 SET DR(1,165.5,11)="382"
+44 SET DR(1,165.5,12)="127"
+45 SET DR(1,165.5,13)="262"
+46 SET DR(1,165.5,14)="260"
+47 SET DR(1,165.5,15)="264"
+48 SET DR(1,165.5,16)="265"
+49 SET DR(1,165.5,17)="266"
+50 SET DR(1,165.5,18)="267"
+51 SET DR(1,165.5,19)="268"
+52 SET DR(1,165.5,29)="269"
+53 DO ^DIE
+54 WRITE !
+55 KILL DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
SET OUT="Y"
+56 QUIT
+57 ;
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 Non-Small Cell Lung Carcinoma")
+8 SET TAB=(80-HDL)\2
SET TAB=TAB-1
+9 WRITE !,?TAB,"Performance Measures for Non-Small Cell Lung Carcinoma"
+10 WRITE !,DASHES
+11 NEW DI,DIC,DR,DA,DIQ,ONC
+12 SET DA=ONCONUM
+13 SET DIC="^ONCO(165.5,"
+14 SET DR="127;251:269;382"
+15 SET DIQ="ONC"
DO EN^DIQ1
+16 FOR I=251,252,254,257,258,259,260,261,262,267,268,269,382,127
SET X=ONC(165.5,ONCONUM,I)
DO UCASE
SET ONC(165.5,ONCONUM,I)=X
+17 WRITE !," NSLC Stage 1-3 Path LN Staging: ",ONC(165.5,ONCONUM,251)
+18 WRITE !," Reason for no LN Biopsy.......: ",ONC(165.5,ONCONUM,252)
+19 WRITE !," Date of Surgery Consult.......: ",ONC(165.5,ONCONUM,253)
+20 WRITE !," Intent of Surgery.............: ",ONC(165.5,ONCONUM,254)
+21 WRITE !," Date Oncology Consult Ordered.: ",ONC(165.5,ONCONUM,255)
+22 WRITE !," Date Oncology Consult Done....: ",ONC(165.5,ONCONUM,256)
+23 WRITE !," Chemotherapy Recommended......: ",ONC(165.5,ONCONUM,257)
+24 WRITE !," Intent of Chemotherapy........: ",ONC(165.5,ONCONUM,258)
+25 WRITE !," Type of Chemotherapy..........: ",ONC(165.5,ONCONUM,259)
+26 WRITE !," Doc for no Plat-based Chemo...: ",ONC(165.5,ONCONUM,261)
+27 WRITE !," Reason Chemotherapy Stopped...: ",ONC(165.5,ONCONUM,382)
+28 WRITE !," Intent of Radiation...........: ",ONC(165.5,ONCONUM,127)
+29 WRITE !," Multimodality Radiation Type..: ",ONC(165.5,ONCONUM,262)
+30 WRITE !," Reason Radiation Stopped......: ",ONC(165.5,ONCONUM,260)
+31 WRITE !," Date Hospice Consult Initiated: ",ONC(165.5,ONCONUM,264)
+32 WRITE !," Date Hospice Consult Completed: ",ONC(165.5,ONCONUM,265)
+33 WRITE !," Date Hospice Care Initiated...: ",ONC(165.5,ONCONUM,266)
+34 WRITE !," EGFR Mutation Testing.........: ",ONC(165.5,ONCONUM,267)
+35 WRITE !," EGFR Mutation 1...............: ",ONC(165.5,ONCONUM,268)
+36 WRITE !," EGFR Mutation 2...............: ",ONC(165.5,ONCONUM,269)
+37 WRITE !,DASHES
+38 QUIT
+39 ;
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
