ONCPHC ;Hines OIFO/GWB - OTHER CANCER (165.5,148) ;05/31/02
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
PHCDEF ;OTHER CANCER (165.5,148) defaults
S SEQNO=+$P(^ONCO(165.5,D0,0),U,6)
S PHCDEF="No"
S PHCDEF(1)="NOT APPLICABLE"
S PHCDEF(2)="NOT APPLICABLE"
S PHCDEF(3)="NOT APPLICABLE"
S PHCDEF(4)="NOT APPLICABLE"
S PRIM=0,PRIMCNT=0
F S PRIM=$O(^ONCO(165.5,"C",ONCOD0,PRIM)) Q:PRIM'>0 D
.I PRIM=D0 Q
.S PHSEQNO=+$P(^ONCO(165.5,PRIM,0),U,6)
.I (PHSEQNO>SEQNO)!(PHSEQNO=SEQNO) Q
.S PRIMCNT=PRIMCNT+1
.S PHC=$P(^ONCO(165.5,PRIM,0),U,1)
.S PHCDEF(PRIMCNT)=$P(^ONCO(164.2,PHC,0),U,1)
.S PHCDEF="Yes"
S:PHCDEF(1)'="" DIE("PTRIX",165.5,148.1,164.2)="B"
S:PHCDEF(2)'="" DIE("PTRIX",165.5,148.2,164.2)="B"
S:PHCDEF(3)'="" DIE("PTRIX",165.5,148.3,164.2)="B"
S:PHCDEF(4)'="" DIE("PTRIX",165.5,148.4,164.2)="B"
K SEQNO,PRIM,PRIMCNT,PHSEQNO,PHC Q
;
PHCDSP ;OTHER CANCER (165.5,148) display
N HDL
S HDL=$L("Patient Identification"),TAB=(80-HDL)\2,TAB=TAB-1
W @IOF,DASHES
W !,?1,PATNAM,?TAB,"Patient Identification",?SITTAB,SITEGP
W !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
W !,DASHES
W !," OTHER CANCER"
W !," ------------"
N DI,DIC,DR,DA,DIQ,ONC
S DIC="^ONCO(165.5,"
S DR="148:148.4"
S DA=D0,DIQ="ONC" D EN^DIQ1
S X=ONC(165.5,D0,148) D UCASE S ONC(165.5,D0,148)=X
W !," Other Cancer...................: ",ONC(165.5,D0,148)
W !," Cancer #1......................: ",ONC(165.5,D0,148.1)
W !," Cancer #2......................: ",ONC(165.5,D0,148.2)
W !," Cancer #3......................: ",ONC(165.5,D0,148.3)
W !," Cancer #4......................: ",ONC(165.5,D0,148.4)
W !,DASHES
Q
;
UCASE S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCPHC 1733 printed Oct 16, 2024@18:27:46 Page 2
ONCPHC ;Hines OIFO/GWB - OTHER CANCER (165.5,148) ;05/31/02
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
PHCDEF ;OTHER CANCER (165.5,148) defaults
+1 SET SEQNO=+$PIECE(^ONCO(165.5,D0,0),U,6)
+2 SET PHCDEF="No"
+3 SET PHCDEF(1)="NOT APPLICABLE"
+4 SET PHCDEF(2)="NOT APPLICABLE"
+5 SET PHCDEF(3)="NOT APPLICABLE"
+6 SET PHCDEF(4)="NOT APPLICABLE"
+7 SET PRIM=0
SET PRIMCNT=0
+8 FOR
SET PRIM=$ORDER(^ONCO(165.5,"C",ONCOD0,PRIM))
if PRIM'>0
QUIT
Begin DoDot:1
+9 IF PRIM=D0
QUIT
+10 SET PHSEQNO=+$PIECE(^ONCO(165.5,PRIM,0),U,6)
+11 IF (PHSEQNO>SEQNO)!(PHSEQNO=SEQNO)
QUIT
+12 SET PRIMCNT=PRIMCNT+1
+13 SET PHC=$PIECE(^ONCO(165.5,PRIM,0),U,1)
+14 SET PHCDEF(PRIMCNT)=$PIECE(^ONCO(164.2,PHC,0),U,1)
+15 SET PHCDEF="Yes"
End DoDot:1
+16 if PHCDEF(1)'=""
SET DIE("PTRIX",165.5,148.1,164.2)="B"
+17 if PHCDEF(2)'=""
SET DIE("PTRIX",165.5,148.2,164.2)="B"
+18 if PHCDEF(3)'=""
SET DIE("PTRIX",165.5,148.3,164.2)="B"
+19 if PHCDEF(4)'=""
SET DIE("PTRIX",165.5,148.4,164.2)="B"
+20 KILL SEQNO,PRIM,PRIMCNT,PHSEQNO,PHC
QUIT
+21 ;
PHCDSP ;OTHER CANCER (165.5,148) display
+1 NEW HDL
+2 SET HDL=$LENGTH("Patient Identification")
SET TAB=(80-HDL)\2
SET TAB=TAB-1
+3 WRITE @IOF,DASHES
+4 WRITE !,?1,PATNAM,?TAB,"Patient Identification",?SITTAB,SITEGP
+5 WRITE !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
+6 WRITE !,DASHES
+7 WRITE !," OTHER CANCER"
+8 WRITE !," ------------"
+9 NEW DI,DIC,DR,DA,DIQ,ONC
+10 SET DIC="^ONCO(165.5,"
+11 SET DR="148:148.4"
+12 SET DA=D0
SET DIQ="ONC"
DO EN^DIQ1
+13 SET X=ONC(165.5,D0,148)
DO UCASE
SET ONC(165.5,D0,148)=X
+14 WRITE !," Other Cancer...................: ",ONC(165.5,D0,148)
+15 WRITE !," Cancer #1......................: ",ONC(165.5,D0,148.1)
+16 WRITE !," Cancer #2......................: ",ONC(165.5,D0,148.2)
+17 WRITE !," Cancer #3......................: ",ONC(165.5,D0,148.3)
+18 WRITE !," Cancer #4......................: ",ONC(165.5,D0,148.4)
+19 WRITE !,DASHES
+20 QUIT
+21 ;
UCASE SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+1 QUIT
