- ONCPDI ;HINES OIFO/GWB - Patient information ;10/07/11
- ;;2.2;ONCOLOGY;**1,13,19,20**;Jul 31, 2013;Build 5
- ;
- PRT ;
- N DI,DIC,DR,DA,DIQ
- K ONC
- N PT,SIG,SOV
- I $$DPTLRT^ONCOES(D0)="LRT" S (SIG,SOV)=""
- I $$DPTLRT^ONCOES(D0)="DPT" D
- .S PT=$P($G(^ONCO(160,D0,0)),";",1)
- .S SOV=$$SO^ONCOES(PT) ;SEXUAL ORIENTATION
- .S SIG=$$GET1^DIQ(2,PT,.024,"E") ;SELF IDENTIFIED GENDER
- S DIC="^ONCO(160,",DR="7;8;8.1;8.2;8.3;8.4;9;10;25;25.1;25.2;25.3;25.4;25.5;25.6;25.7;25.8;25.9;48;50;51;52;61;55;56;62;63;64;65;66;67;71;72;73;1006;25.91:25.9901"
- S DA=D0,DIQ="ONC"
- D EN^DIQ1
- F I=7,71,8,8.1,8.2,8.3,8.4,9,10,48,50,51,52,61,55,56,62,63,64,65,66,67,72,73 S X=ONC(160,D0,I) D UCASE^ONCPCI S ONC(160,D0,I)=X
- W !
- W !," Place of birth.............: ",ONC(160,D0,7)
- W !," Birth Surname..............: ",ONC(160,D0,71)
- W !," Race 1.....................: ",ONC(160,D0,8)
- W !," Race 2.....................: ",ONC(160,D0,8.1)
- W !," Race 3.....................: ",ONC(160,D0,8.2)
- W !," Race 4.....................: ",ONC(160,D0,8.3)
- W !," Race 5.....................: ",ONC(160,D0,8.4)
- W !," Spanish origin.............: ",ONC(160,D0,9)
- W !," Sex........................: ",ONC(160,D0,10)
- W !," Sexual Orientation.........: ",SOV
- W !," Self Identified Gender.....: ",SIG
- W !," Exposure Agent Orange......: ",ONC(160,D0,48)
- W !," Exposure Ionizing Radiation: ",ONC(160,D0,50)
- W !," Exposure Chemical..........: ",ONC(160,D0,52)
- W !," Exposure Asbestos..........: ",ONC(160,D0,61)
- W !," Exposure Burn Pit..........: ",ONC(160,D0,72)
- W !," Exposure Other Toxic.......: ",ONC(160,D0,73)
- W !," Vietnam service............: ",ONC(160,D0,62)
- W !," Lebanon service............: ",ONC(160,D0,55)
- W !," Grenada service............: ",ONC(160,D0,63)
- W !," Panama service.............: ",ONC(160,D0,64)
- W !," Persian Gulf service.......: ",ONC(160,D0,51)
- W !," Somalia service............: ",ONC(160,D0,56)
- W !," Yugoslavia service.........: ",ONC(160,D0,65)
- W !," Afghanistan (OEF) service..: ",ONC(160,D0,67)
- W !," Iraq (OIF) service.........: ",ONC(160,D0,66)
- Q
- ;
- PH ;Patient History
- K ONC S IEN=D0_","
- D GETS^DIQ(160,IEN,"38;39;42*;43;44*","","ONC")
- F I=38,39,43 S X=ONC(160,D0_",",I) D UCASE^ONCPCI S ONC(160,D0_",",I)=X
- W @IOF
- S SUB=0 F S SUB=$O(ONC(160.042,SUB)) Q:SUB'>0 D
- .W !," Usual Occupation...........: ",ONC(160.042,SUB,.01)
- .W !," Usual Industry.............: ",ONC(160.042,SUB,3)
- .W !
- W !," Tobacco History............: ",ONC(160,IEN,38)
- W !," Alcohol History............: ",ONC(160,IEN,39)
- W !
- W !," Family History of Cancer...: ",ONC(160,IEN,43)
- S SUB=0 F S SUB=$O(ONC(160.044,SUB)) Q:SUB'>0 D
- .W !," Family Member with Cancer..: ",ONC(160.044,SUB,.01),?50,"(",ONC(160.044,SUB,1),")"
- W !
- K I,IEN,ONC,SUB,X
- Q
- ;
- CLEANUP ;Cleanup
- K D0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCPDI 2932 printed Feb 18, 2025@23:53:34 Page 2
- ONCPDI ;HINES OIFO/GWB - Patient information ;10/07/11
- +1 ;;2.2;ONCOLOGY;**1,13,19,20**;Jul 31, 2013;Build 5
- +2 ;
- PRT ;
- +1 NEW DI,DIC,DR,DA,DIQ
- +2 KILL ONC
- +3 NEW PT,SIG,SOV
- +4 IF $$DPTLRT^ONCOES(D0)="LRT"
- SET (SIG,SOV)=""
- +5 IF $$DPTLRT^ONCOES(D0)="DPT"
- Begin DoDot:1
- +6 SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
- +7 ;SEXUAL ORIENTATION
- SET SOV=$$SO^ONCOES(PT)
- +8 ;SELF IDENTIFIED GENDER
- SET SIG=$$GET1^DIQ(2,PT,.024,"E")
- End DoDot:1
- +9 SET DIC="^ONCO(160,"
- SET DR="7;8;8.1;8.2;8.3;8.4;9;10;25;25.1;25.2;25.3;25.4;25.5;25.6;25.7;25.8;25.9;48;50;51;52;61;55;56;62;63;64;65;66;67;71;72;73;1006;25.91:25.9901"
- +10 SET DA=D0
- SET DIQ="ONC"
- +11 DO EN^DIQ1
- +12 FOR I=7,71,8,8.1,8.2,8.3,8.4,9,10,48,50,51,52,61,55,56,62,63,64,65,66,67,72,73
- SET X=ONC(160,D0,I)
- DO UCASE^ONCPCI
- SET ONC(160,D0,I)=X
- +13 WRITE !
- +14 WRITE !," Place of birth.............: ",ONC(160,D0,7)
- +15 WRITE !," Birth Surname..............: ",ONC(160,D0,71)
- +16 WRITE !," Race 1.....................: ",ONC(160,D0,8)
- +17 WRITE !," Race 2.....................: ",ONC(160,D0,8.1)
- +18 WRITE !," Race 3.....................: ",ONC(160,D0,8.2)
- +19 WRITE !," Race 4.....................: ",ONC(160,D0,8.3)
- +20 WRITE !," Race 5.....................: ",ONC(160,D0,8.4)
- +21 WRITE !," Spanish origin.............: ",ONC(160,D0,9)
- +22 WRITE !," Sex........................: ",ONC(160,D0,10)
- +23 WRITE !," Sexual Orientation.........: ",SOV
- +24 WRITE !," Self Identified Gender.....: ",SIG
- +25 WRITE !," Exposure Agent Orange......: ",ONC(160,D0,48)
- +26 WRITE !," Exposure Ionizing Radiation: ",ONC(160,D0,50)
- +27 WRITE !," Exposure Chemical..........: ",ONC(160,D0,52)
- +28 WRITE !," Exposure Asbestos..........: ",ONC(160,D0,61)
- +29 WRITE !," Exposure Burn Pit..........: ",ONC(160,D0,72)
- +30 WRITE !," Exposure Other Toxic.......: ",ONC(160,D0,73)
- +31 WRITE !," Vietnam service............: ",ONC(160,D0,62)
- +32 WRITE !," Lebanon service............: ",ONC(160,D0,55)
- +33 WRITE !," Grenada service............: ",ONC(160,D0,63)
- +34 WRITE !," Panama service.............: ",ONC(160,D0,64)
- +35 WRITE !," Persian Gulf service.......: ",ONC(160,D0,51)
- +36 WRITE !," Somalia service............: ",ONC(160,D0,56)
- +37 WRITE !," Yugoslavia service.........: ",ONC(160,D0,65)
- +38 WRITE !," Afghanistan (OEF) service..: ",ONC(160,D0,67)
- +39 WRITE !," Iraq (OIF) service.........: ",ONC(160,D0,66)
- +40 QUIT
- +41 ;
- PH ;Patient History
- +1 KILL ONC
- SET IEN=D0_","
- +2 DO GETS^DIQ(160,IEN,"38;39;42*;43;44*","","ONC")
- +3 FOR I=38,39,43
- SET X=ONC(160,D0_",",I)
- DO UCASE^ONCPCI
- SET ONC(160,D0_",",I)=X
- +4 WRITE @IOF
- +5 SET SUB=0
- FOR
- SET SUB=$ORDER(ONC(160.042,SUB))
- if SUB'>0
- QUIT
- Begin DoDot:1
- +6 WRITE !," Usual Occupation...........: ",ONC(160.042,SUB,.01)
- +7 WRITE !," Usual Industry.............: ",ONC(160.042,SUB,3)
- +8 WRITE !
- End DoDot:1
- +9 WRITE !," Tobacco History............: ",ONC(160,IEN,38)
- +10 WRITE !," Alcohol History............: ",ONC(160,IEN,39)
- +11 WRITE !
- +12 WRITE !," Family History of Cancer...: ",ONC(160,IEN,43)
- +13 SET SUB=0
- FOR
- SET SUB=$ORDER(ONC(160.044,SUB))
- if SUB'>0
- QUIT
- Begin DoDot:1
- +14 WRITE !," Family Member with Cancer..: ",ONC(160.044,SUB,.01),?50,"(",ONC(160.044,SUB,1),")"
- End DoDot:1
- +15 WRITE !
- +16 KILL I,IEN,ONC,SUB,X
- +17 QUIT
- +18 ;
- CLEANUP ;Cleanup
- +1 KILL D0