| [613] | 1 | ONCPHC ;Hines OIFO/GWB - PREVIOUS HISTORY OF CANCER ;05/31/02
|
|---|
| 2 | ;;2.11;ONCOLOGY;**33,36**;Mar 07, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | PHCDEF ;PREVIOUS HISTORY OF CANCER defaults
|
|---|
| 5 | S SEQNO=+$P(^ONCO(165.5,D0,0),U,6)
|
|---|
| 6 | S PHCDEF="No"
|
|---|
| 7 | S PHCDEF(1)="NOT APPLICABLE"
|
|---|
| 8 | S PHCDEF(2)="NOT APPLICABLE"
|
|---|
| 9 | S PHCDEF(3)="NOT APPLICABLE"
|
|---|
| 10 | S PHCDEF(4)="NOT APPLICABLE"
|
|---|
| 11 | S PRIM=0,PRIMCNT=0
|
|---|
| 12 | F S PRIM=$O(^ONCO(165.5,"C",ONCOD0,PRIM)) Q:PRIM'>0 D
|
|---|
| 13 | .I PRIM=D0 Q
|
|---|
| 14 | .S PHSEQNO=+$P(^ONCO(165.5,PRIM,0),U,6)
|
|---|
| 15 | .I (PHSEQNO>SEQNO)!(PHSEQNO=SEQNO) Q
|
|---|
| 16 | .S PRIMCNT=PRIMCNT+1
|
|---|
| 17 | .S PHC=$P(^ONCO(165.5,PRIM,0),U,1)
|
|---|
| 18 | .S PHCDEF(PRIMCNT)=$P(^ONCO(164.2,PHC,0),U,1)
|
|---|
| 19 | .S PHCDEF="Yes"
|
|---|
| 20 | S:PHCDEF(1)'="" DIE("PTRIX",165.5,148.1,164.2)="B"
|
|---|
| 21 | S:PHCDEF(2)'="" DIE("PTRIX",165.5,148.2,164.2)="B"
|
|---|
| 22 | S:PHCDEF(3)'="" DIE("PTRIX",165.5,148.3,164.2)="B"
|
|---|
| 23 | S:PHCDEF(4)'="" DIE("PTRIX",165.5,148.4,164.2)="B"
|
|---|
| 24 | K SEQNO,PRIM,PRIMCNT,PHSEQNO,PHC Q
|
|---|
| 25 | ;
|
|---|
| 26 | PHCDSP ;PREVIOUS HISTORY OF CANCER display
|
|---|
| 27 | S HDL=$L("Patient Identification"),TAB=(80-HDL)\2,TAB=TAB-1
|
|---|
| 28 | W @IOF,DASHES
|
|---|
| 29 | W !,?1,PATNAM,?TAB,"Patient Identification",?SITTAB,SITEGP
|
|---|
| 30 | W !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
|
|---|
| 31 | W !,DASHES
|
|---|
| 32 | W !," PREVIOUS HISTORY OF CANCER"
|
|---|
| 33 | W !," --------------------------"
|
|---|
| 34 | N DI,DIC,DR,DA,DIQ,ONC
|
|---|
| 35 | S DIC="^ONCO(165.5,"
|
|---|
| 36 | S DR="148:148.4"
|
|---|
| 37 | S DA=D0,DIQ="ONC" D EN^DIQ1
|
|---|
| 38 | S X=ONC(165.5,D0,148) D UCASE S ONC(165.5,D0,148)=X
|
|---|
| 39 | W !," Previous History of Cancer.....: ",ONC(165.5,D0,148)
|
|---|
| 40 | W !," Cancer #1......................: ",ONC(165.5,D0,148.1)
|
|---|
| 41 | W !," Cancer #2......................: ",ONC(165.5,D0,148.2)
|
|---|
| 42 | W !," Cancer #3......................: ",ONC(165.5,D0,148.3)
|
|---|
| 43 | W !," Cancer #4......................: ",ONC(165.5,D0,148.4)
|
|---|
| 44 | W !,DASHES
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | UCASE S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 48 | Q
|
|---|
