- 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 Feb 18, 2025@23:53:35 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