Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCPHC

ONCPHC.m

Go to the documentation of this file.
  1. ONCPHC ;Hines OIFO/GWB - OTHER CANCER (165.5,148) ;05/31/02
  1. ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
  1. ;
  1. PHCDEF ;OTHER CANCER (165.5,148) defaults
  1. S SEQNO=+$P(^ONCO(165.5,D0,0),U,6)
  1. S PHCDEF="No"
  1. S PHCDEF(1)="NOT APPLICABLE"
  1. S PHCDEF(2)="NOT APPLICABLE"
  1. S PHCDEF(3)="NOT APPLICABLE"
  1. S PHCDEF(4)="NOT APPLICABLE"
  1. S PRIM=0,PRIMCNT=0
  1. F S PRIM=$O(^ONCO(165.5,"C",ONCOD0,PRIM)) Q:PRIM'>0 D
  1. .I PRIM=D0 Q
  1. .S PHSEQNO=+$P(^ONCO(165.5,PRIM,0),U,6)
  1. .I (PHSEQNO>SEQNO)!(PHSEQNO=SEQNO) Q
  1. .S PRIMCNT=PRIMCNT+1
  1. .S PHC=$P(^ONCO(165.5,PRIM,0),U,1)
  1. .S PHCDEF(PRIMCNT)=$P(^ONCO(164.2,PHC,0),U,1)
  1. .S PHCDEF="Yes"
  1. S:PHCDEF(1)'="" DIE("PTRIX",165.5,148.1,164.2)="B"
  1. S:PHCDEF(2)'="" DIE("PTRIX",165.5,148.2,164.2)="B"
  1. S:PHCDEF(3)'="" DIE("PTRIX",165.5,148.3,164.2)="B"
  1. S:PHCDEF(4)'="" DIE("PTRIX",165.5,148.4,164.2)="B"
  1. K SEQNO,PRIM,PRIMCNT,PHSEQNO,PHC Q
  1. ;
  1. PHCDSP ;OTHER CANCER (165.5,148) display
  1. N HDL
  1. S HDL=$L("Patient Identification"),TAB=(80-HDL)\2,TAB=TAB-1
  1. W @IOF,DASHES
  1. W !,?1,PATNAM,?TAB,"Patient Identification",?SITTAB,SITEGP
  1. W !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
  1. W !,DASHES
  1. W !," OTHER CANCER"
  1. W !," ------------"
  1. N DI,DIC,DR,DA,DIQ,ONC
  1. S DIC="^ONCO(165.5,"
  1. S DR="148:148.4"
  1. S DA=D0,DIQ="ONC" D EN^DIQ1
  1. S X=ONC(165.5,D0,148) D UCASE S ONC(165.5,D0,148)=X
  1. W !," Other Cancer...................: ",ONC(165.5,D0,148)
  1. W !," Cancer #1......................: ",ONC(165.5,D0,148.1)
  1. W !," Cancer #2......................: ",ONC(165.5,D0,148.2)
  1. W !," Cancer #3......................: ",ONC(165.5,D0,148.3)
  1. W !," Cancer #4......................: ",ONC(165.5,D0,148.4)
  1. W !,DASHES
  1. Q
  1. ;
  1. UCASE S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. Q