ONCPMP ;Hines OIFO/GWB - PROSTATE 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,25)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,25)=0
.S:$P($G(^ONCO(165.5,ONCONUM,"PM")),U,27)="" $P(^ONCO(165.5,ONCONUM,"PM"),U,27)=0
.S:$P($G(^ONCO(165.5,ONCONUM,"BLA2")),U,41)="" $P(^ONCO(165.5,ONCONUM,"BLA2"),U,41)=0
K DIR D HEAD
S DR=""
S DR(1,165.5,1)="275"
S DR(1,165.5,2)="276"
S DR(1,165.5,3)="277"
S DR(1,165.5,4)="278"
S DR(1,165.5,5)="382"
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 Cancer of the Prostate")
S TAB=(80-HDL)\2,TAB=TAB-1
W !,?TAB,"Performance Measures for Cancer of the Prostate"
W !,DASHES
N DI,DIC,DR,DA,DIQ,ONC
S DA=ONCONUM
S DIC="^ONCO(165.5,"
S DR="275:278;382"
S DIQ="ONC" D EN^DIQ1
F I=275,276,277,278,382 S X=ONC(165.5,ONCONUM,I) D UCASE S ONC(165.5,ONCONUM,I)=X
W !," Risk of recurrence............: ",ONC(165.5,ONCONUM,275)
W !," Androgen Deprivation Therapy..: ",ONC(165.5,ONCONUM,276)
W !," Date ADT initiated............: ",ONC(165.5,ONCONUM,277)
W !," Non-ADT Chemotherapy..........: ",ONC(165.5,ONCONUM,278)
W !," Reason Chemotherapy Stopped...: ",ONC(165.5,ONCONUM,382)
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[HONCPMP 1838 printed Sep 23, 2025@20:03:17 Page 2
ONCPMP ;Hines OIFO/GWB - PROSTATE 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,25)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,25)=0
+8 if $PIECE($GET(^ONCO(165.5,ONCONUM,"PM")),U,27)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"PM"),U,27)=0
+9 if $PIECE($GET(^ONCO(165.5,ONCONUM,"BLA2")),U,41)=""
SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,41)=0
End DoDot:1
+10 KILL DIR
DO HEAD
+11 SET DR=""
+12 SET DR(1,165.5,1)="275"
+13 SET DR(1,165.5,2)="276"
+14 SET DR(1,165.5,3)="277"
+15 SET DR(1,165.5,4)="278"
+16 SET DR(1,165.5,5)="382"
+17 DO ^DIE
+18 WRITE !
+19 KILL DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
SET OUT="Y"
+20 QUIT
+21 ;
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 Cancer of the Prostate")
+8 SET TAB=(80-HDL)\2
SET TAB=TAB-1
+9 WRITE !,?TAB,"Performance Measures for Cancer of the Prostate"
+10 WRITE !,DASHES
+11 NEW DI,DIC,DR,DA,DIQ,ONC
+12 SET DA=ONCONUM
+13 SET DIC="^ONCO(165.5,"
+14 SET DR="275:278;382"
+15 SET DIQ="ONC"
DO EN^DIQ1
+16 FOR I=275,276,277,278,382
SET X=ONC(165.5,ONCONUM,I)
DO UCASE
SET ONC(165.5,ONCONUM,I)=X
+17 WRITE !," Risk of recurrence............: ",ONC(165.5,ONCONUM,275)
+18 WRITE !," Androgen Deprivation Therapy..: ",ONC(165.5,ONCONUM,276)
+19 WRITE !," Date ADT initiated............: ",ONC(165.5,ONCONUM,277)
+20 WRITE !," Non-ADT Chemotherapy..........: ",ONC(165.5,ONCONUM,278)
+21 WRITE !," Reason Chemotherapy Stopped...: ",ONC(165.5,ONCONUM,382)
+22 WRITE !,DASHES
+23 QUIT
+24 ;
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
