- ONCIPC8 ;Hines OIFO/GWB - Primary Intracranial/CNS Tumors PCE Study ;05/01/00
- ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- ;Print
- K IOP,%ZIS S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KILL
- I $D(IO("Q")) S ONCOLST="ONCONUM^ONCOPA^PATNAM^SPACES^TOPNAM^SSN^TOPTAB^TOPCOD^DASHES^SITTAB^SITEGP" D TASK G KILL
- U IO D PRT D ^%ZISC K %ZIS,IOP G KILL
- PRT S EX="",LIN=$S(IOST?1"C".E:IOSL-2,1:IOSL-4),IE=ONCONUM
- D NOW^%DTC S ONDATE=%,Y=ONDATE X ^DD("DD") S ONDATE=$P(Y,":",1,2)
- S HIST=$P($G(^ONCO(165.5,ONCONUM,2)),U,3)
- K LINE S $P(LINE,"-",40)="-"
- I D HEAD^ONCIPC0
- S TABLE="PATIENT INFORMATION"
- K LINE S $P(LINE,"-",19)="-"
- W !?4,TABLE,!?4,LINE
- S D0=ONCOPA D DOB1^ONCOES S Y=X D DATEOT^ONCOPCE S DOB=Y
- W !," 1. FACILITY ID NUMBER (FIN)......: ",$$IIN^ONCFUNC
- D P Q:EX=U
- W !," 2. ACCESSION NUMBER..............: ",$$GET1^DIQ(165.5,IE,.05)
- D P Q:EX=U
- W !," 3. SEQUENCE NUMBER...............: ",$$GET1^DIQ(165.5,IE,.06)
- D P Q:EX=U
- W !," 4. POSTAL CODE AT DIAGNOSIS......: ",$$GET1^DIQ(165.5,IE,9)
- D P Q:EX=U
- W !," 5. DATE OF BIRTH.................: ",DOB
- D P Q:EX=U
- W !," 6. RACE..........................: ",$$GET1^DIQ(165.5,IE,.12)
- D P Q:EX=U
- W !," 7. SPANISH ORIGIN................: ",$$GET1^DIQ(160,ONCOPA,9)
- D P Q:EX=U
- W !," 8. SEX...........................: ",$$GET1^DIQ(160,ONCOPA,10)
- D P Q:EX=U
- W !," 9. HANDEDNESS....................: ",$$GET1^DIQ(165.5,IE,1200)
- D P Q:EX=U
- W !,"10. PRIOR EXPOSURE TO RADIATION...: ",$$GET1^DIQ(165.5,IE,403)
- D P Q:EX=U
- W !,"11. PRIMARY PAYER AT DIAGNOSIS....: ",$$GET1^DIQ(165.5,IE,18)
- D P Q:EX=U
- W !
- D P Q:EX=U
- W !,"12. PRIOR MEDICAL CONDITIONS:"
- D P Q:EX=U
- W !," HYPERTENSION.................: ",$$GET1^DIQ(165.5,IE,1201)
- D P Q:EX=U
- W !," MULTIPLE SCLEROSIS (MS)......: ",$$GET1^DIQ(165.5,IE,1202)
- D P Q:EX=U
- W !," DIABETES.....................: ",$$GET1^DIQ(165.5,IE,1203)
- D P Q:EX=U
- W !," MYOCARDIAL INFARCTION (MI)...: ",$$GET1^DIQ(165.5,IE,354)
- D P Q:EX=U
- W !," CEREBROVASCULAR DISEASE......: ",$$GET1^DIQ(165.5,IE,1204)
- D P Q:EX=U
- W !
- D P Q:EX=U
- W !,"13. PERSONAL HISTORY OF OTHER CANCER:"
- D P Q:EX=U
- W !," BRAIN........................: ",$$GET1^DIQ(165.5,IE,1205)
- D P Q:EX=U
- W !," BREAST.......................: ",$$GET1^DIQ(165.5,IE,1206)
- D P Q:EX=U
- W !," PROSTATE.....................: ",$$GET1^DIQ(165.5,IE,1207)
- D P Q:EX=U
- W !," MALIGNANT MELANOMA...........: ",$$GET1^DIQ(165.5,IE,1208)
- D P Q:EX=U
- W !," OTHER SKIN CANCER............: ",$$GET1^DIQ(165.5,IE,1209)
- D P Q:EX=U
- W !," LEUKEMIA.....................: ",$$GET1^DIQ(165.5,IE,1210)
- D P Q:EX=U
- W !," COLON OR OTHER GI CANCERS....: ",$$GET1^DIQ(165.5,IE,1211)
- D P Q:EX=U
- W !," OTHER........................: ",$$GET1^DIQ(165.5,IE,1212)
- D P Q:EX=U
- I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y D HEAD^ONCIPC0 G GP
- W !
- D P Q:EX=U
- GP W !,"14. GENETIC PREDISPOSITION:"
- D P Q:EX=U
- W !," NEUROFIBROMATOSIS............: ",$$GET1^DIQ(165.5,IE,1213)
- D P Q:EX=U
- W !," VON HIPPEL-LINDAU DISEASE....: ",$$GET1^DIQ(165.5,IE,1214)
- D P Q:EX=U
- W !," TUBEROUS SCLEROSIS...........: ",$$GET1^DIQ(165.5,IE,1215)
- D P Q:EX=U
- W !," TURCOT SYNDROME..............: ",$$GET1^DIQ(165.5,IE,1216)
- D P Q:EX=U
- W !," LI-FRAUMENI SYNDROME.........: ",$$GET1^DIQ(165.5,IE,1217)
- D P Q:EX=U
- W !," KOWDEN DISEASE...............: ",$$GET1^DIQ(165.5,IE,1218)
- D P Q:EX=U
- W !," NEVOID BASAL CELL CARCINOMA"
- D P Q:EX=U
- W !," SYNDROME....................: ",$$GET1^DIQ(165.5,IE,1219)
- D P Q:EX=U
- W !
- D P Q:EX=U
- W !," 15. USUAL OCCUPATION.............: ",$$OCCUP^ONCACDU1(ONCOPA)
- D P Q:EX=U
- W !," 16. USUAL INDUSTRY...............: ",$$OCCUP^ONCACDU1(ONCOPA)
- I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR G:'Y KILL D HEAD^ONCIPC0 G II
- D P Q:EX=U
- II S TABLE="TUMOR IDENTIFICATION"
- I IOST'?1"C".E W ! I ($Y'<(LIN-4)) D HEAD^ONCIPC0
- K LINE S $P(LINE,"-",20)="-"
- W !?4,TABLE,!?4,LINE
- D P Q:EX=U
- W !,"17. CLASS OF CASE.................: ",$$GET1^DIQ(165.5,IE,.04)
- D P Q:EX=U
- W !
- D P Q:EX=U
- W !,"18. SYMPTOMS:"
- D P Q:EX=U
- W !," HEADACHE.....................: ",$$GET1^DIQ(165.5,IE,1220)
- D P Q:EX=U
- W !," NAUSEA/VOMITING..............: ",$$GET1^DIQ(165.5,IE,1221)
- D P Q:EX=U
- W !," CHANGE IN SENSE OF SMELL AND/"
- D P Q:EX=U
- W !," OR TASTE....................: ",$$GET1^DIQ(165.5,IE,1222)
- D P Q:EX=U
- W !," ALTERED ALERTNESS............: ",$$GET1^DIQ(165.5,IE,1223)
- D P Q:EX=U
- W !," FATIGUE......................: ",$$GET1^DIQ(165.5,IE,1224)
- D P Q:EX=U
- W !," SPEECH DISTURBANCE...........: ",$$GET1^DIQ(165.5,IE,1225)
- D P Q:EX=U
- W !," PERSONALITY CHANGES..........: ",$$GET1^DIQ(165.5,IE,1226)
- D P Q:EX=U
- W !," DEPRESSION...................: ",$$GET1^DIQ(165.5,IE,1227)
- D P Q:EX=U
- W !," MEMORY LOSS..................: ",$$GET1^DIQ(165.5,IE,1228)
- D P Q:EX=U
- W !," LACK OF CONCENTRATION........: ",$$GET1^DIQ(165.5,IE,1229)
- D P Q:EX=U
- W !," DOUBLE VISION................: ",$$GET1^DIQ(165.5,IE,1230)
- D P Q:EX=U
- W !," OTHER VISUAL DISTURBANCE.....: ",$$GET1^DIQ(165.5,IE,1231)
- D P Q:EX=U
- W !," DECREASED HEARING............: ",$$GET1^DIQ(165.5,IE,1232)
- D P Q:EX=U
- W !," VERTIGO......................: ",$$GET1^DIQ(165.5,IE,1233)
- D P Q:EX=U
- W !," TINNITUS.....................: ",$$GET1^DIQ(165.5,IE,1234)
- D P Q:EX=U
- W !," NUMBNESS/TINGLING............: ",$$GET1^DIQ(165.5,IE,1235)
- D P Q:EX=U
- W !," WEAKNESS OR PARALYSIS........: ",$$GET1^DIQ(165.5,IE,1236)
- D P Q:EX=U
- W !," DIFFICULTY IN COORDINATION/"
- D P Q:EX=U
- W !," BALANCE.....................: ",$$GET1^DIQ(165.5,IE,1237)
- D P Q:EX=U
- W !," GENERALIZED SEIZURE..........: ",$$GET1^DIQ(165.5,IE,1238)
- D P Q:EX=U
- W !," FOCAL SEIZURE................: ",$$GET1^DIQ(165.5,IE,1239)
- D P Q:EX=U
- W !," BLADDER INCONTINENCE.........: ",$$GET1^DIQ(165.5,IE,1240)
- D P Q:EX=U
- W !," BOWEL INCONTINENCE...........: ",$$GET1^DIQ(165.5,IE,1241)
- D P Q:EX=U
- W !," PAIN (OTHER THAN HEADACHE)...: ",$$GET1^DIQ(165.5,IE,1242)
- D P Q:EX=U
- W !," WEIGHT CHANGE................: ",$$GET1^DIQ(165.5,IE,1243)
- D P Q:EX=U
- W !," OTHER........................: ",$$GET1^DIQ(165.5,IE,1244)
- D P Q:EX=U
- W !
- D P Q:EX=U
- D:IOST?1"C".E HEAD^ONCIPC0 D ^ONCIPC8A
- KILL ;Kill variables
- K EX,IE,LIN,ONDATE,X,Y
- Q
- P ;Print
- I ($Y'<(LIN-1)) D Q:EX=U
- .I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
- .D HEAD^ONCIPC0 Q
- Q
- TASK ;Queue a task
- K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
- S ZTRTN="PRT^ONCIPC8",ZTREQ="@",ZTSAVE("ZTREQ")=""
- S ZTDESC="Print Intracranial & CNS PCE"
- F V2=1:1 S V1=$P(ONCOLST,"^",V2) Q:V1="" S ZTSAVE(V1)=""
- D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
- K V1,V2,ONCOLST,ZTSK Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCIPC8 6900 printed Feb 18, 2025@23:49:48 Page 2
- ONCIPC8 ;Hines OIFO/GWB - Primary Intracranial/CNS Tumors PCE Study ;05/01/00
- +1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- +2 ;Print
- +3 KILL IOP,%ZIS
- SET %ZIS="MQ"
- WRITE !
- DO ^%ZIS
- KILL %ZIS,IOP
- if POP
- GOTO KILL
- +4 IF $DATA(IO("Q"))
- SET ONCOLST="ONCONUM^ONCOPA^PATNAM^SPACES^TOPNAM^SSN^TOPTAB^TOPCOD^DASHES^SITTAB^SITEGP"
- DO TASK
- GOTO KILL
- +5 USE IO
- DO PRT
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO KILL
- PRT SET EX=""
- SET LIN=$SELECT(IOST?1"C".E:IOSL-2,1:IOSL-4)
- SET IE=ONCONUM
- +1 DO NOW^%DTC
- SET ONDATE=%
- SET Y=ONDATE
- XECUTE ^DD("DD")
- SET ONDATE=$PIECE(Y,":",1,2)
- +2 SET HIST=$PIECE($GET(^ONCO(165.5,ONCONUM,2)),U,3)
- +3 KILL LINE
- SET $PIECE(LINE,"-",40)="-"
- I DO HEAD^ONCIPC0
- +1 SET TABLE="PATIENT INFORMATION"
- +2 KILL LINE
- SET $PIECE(LINE,"-",19)="-"
- +3 WRITE !?4,TABLE,!?4,LINE
- +4 SET D0=ONCOPA
- DO DOB1^ONCOES
- SET Y=X
- DO DATEOT^ONCOPCE
- SET DOB=Y
- +5 WRITE !," 1. FACILITY ID NUMBER (FIN)......: ",$$IIN^ONCFUNC
- +6 DO P
- if EX=U
- QUIT
- +7 WRITE !," 2. ACCESSION NUMBER..............: ",$$GET1^DIQ(165.5,IE,.05)
- +8 DO P
- if EX=U
- QUIT
- +9 WRITE !," 3. SEQUENCE NUMBER...............: ",$$GET1^DIQ(165.5,IE,.06)
- +10 DO P
- if EX=U
- QUIT
- +11 WRITE !," 4. POSTAL CODE AT DIAGNOSIS......: ",$$GET1^DIQ(165.5,IE,9)
- +12 DO P
- if EX=U
- QUIT
- +13 WRITE !," 5. DATE OF BIRTH.................: ",DOB
- +14 DO P
- if EX=U
- QUIT
- +15 WRITE !," 6. RACE..........................: ",$$GET1^DIQ(165.5,IE,.12)
- +16 DO P
- if EX=U
- QUIT
- +17 WRITE !," 7. SPANISH ORIGIN................: ",$$GET1^DIQ(160,ONCOPA,9)
- +18 DO P
- if EX=U
- QUIT
- +19 WRITE !," 8. SEX...........................: ",$$GET1^DIQ(160,ONCOPA,10)
- +20 DO P
- if EX=U
- QUIT
- +21 WRITE !," 9. HANDEDNESS....................: ",$$GET1^DIQ(165.5,IE,1200)
- +22 DO P
- if EX=U
- QUIT
- +23 WRITE !,"10. PRIOR EXPOSURE TO RADIATION...: ",$$GET1^DIQ(165.5,IE,403)
- +24 DO P
- if EX=U
- QUIT
- +25 WRITE !,"11. PRIMARY PAYER AT DIAGNOSIS....: ",$$GET1^DIQ(165.5,IE,18)
- +26 DO P
- if EX=U
- QUIT
- +27 WRITE !
- +28 DO P
- if EX=U
- QUIT
- +29 WRITE !,"12. PRIOR MEDICAL CONDITIONS:"
- +30 DO P
- if EX=U
- QUIT
- +31 WRITE !," HYPERTENSION.................: ",$$GET1^DIQ(165.5,IE,1201)
- +32 DO P
- if EX=U
- QUIT
- +33 WRITE !," MULTIPLE SCLEROSIS (MS)......: ",$$GET1^DIQ(165.5,IE,1202)
- +34 DO P
- if EX=U
- QUIT
- +35 WRITE !," DIABETES.....................: ",$$GET1^DIQ(165.5,IE,1203)
- +36 DO P
- if EX=U
- QUIT
- +37 WRITE !," MYOCARDIAL INFARCTION (MI)...: ",$$GET1^DIQ(165.5,IE,354)
- +38 DO P
- if EX=U
- QUIT
- +39 WRITE !," CEREBROVASCULAR DISEASE......: ",$$GET1^DIQ(165.5,IE,1204)
- +40 DO P
- if EX=U
- QUIT
- +41 WRITE !
- +42 DO P
- if EX=U
- QUIT
- +43 WRITE !,"13. PERSONAL HISTORY OF OTHER CANCER:"
- +44 DO P
- if EX=U
- QUIT
- +45 WRITE !," BRAIN........................: ",$$GET1^DIQ(165.5,IE,1205)
- +46 DO P
- if EX=U
- QUIT
- +47 WRITE !," BREAST.......................: ",$$GET1^DIQ(165.5,IE,1206)
- +48 DO P
- if EX=U
- QUIT
- +49 WRITE !," PROSTATE.....................: ",$$GET1^DIQ(165.5,IE,1207)
- +50 DO P
- if EX=U
- QUIT
- +51 WRITE !," MALIGNANT MELANOMA...........: ",$$GET1^DIQ(165.5,IE,1208)
- +52 DO P
- if EX=U
- QUIT
- +53 WRITE !," OTHER SKIN CANCER............: ",$$GET1^DIQ(165.5,IE,1209)
- +54 DO P
- if EX=U
- QUIT
- +55 WRITE !," LEUKEMIA.....................: ",$$GET1^DIQ(165.5,IE,1210)
- +56 DO P
- if EX=U
- QUIT
- +57 WRITE !," COLON OR OTHER GI CANCERS....: ",$$GET1^DIQ(165.5,IE,1211)
- +58 DO P
- if EX=U
- QUIT
- +59 WRITE !," OTHER........................: ",$$GET1^DIQ(165.5,IE,1212)
- +60 DO P
- if EX=U
- QUIT
- +61 IF IOST?1"C".E
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- if 'Y
- QUIT
- DO HEAD^ONCIPC0
- GOTO GP
- +62 WRITE !
- +63 DO P
- if EX=U
- QUIT
- GP WRITE !,"14. GENETIC PREDISPOSITION:"
- +1 DO P
- if EX=U
- QUIT
- +2 WRITE !," NEUROFIBROMATOSIS............: ",$$GET1^DIQ(165.5,IE,1213)
- +3 DO P
- if EX=U
- QUIT
- +4 WRITE !," VON HIPPEL-LINDAU DISEASE....: ",$$GET1^DIQ(165.5,IE,1214)
- +5 DO P
- if EX=U
- QUIT
- +6 WRITE !," TUBEROUS SCLEROSIS...........: ",$$GET1^DIQ(165.5,IE,1215)
- +7 DO P
- if EX=U
- QUIT
- +8 WRITE !," TURCOT SYNDROME..............: ",$$GET1^DIQ(165.5,IE,1216)
- +9 DO P
- if EX=U
- QUIT
- +10 WRITE !," LI-FRAUMENI SYNDROME.........: ",$$GET1^DIQ(165.5,IE,1217)
- +11 DO P
- if EX=U
- QUIT
- +12 WRITE !," KOWDEN DISEASE...............: ",$$GET1^DIQ(165.5,IE,1218)
- +13 DO P
- if EX=U
- QUIT
- +14 WRITE !," NEVOID BASAL CELL CARCINOMA"
- +15 DO P
- if EX=U
- QUIT
- +16 WRITE !," SYNDROME....................: ",$$GET1^DIQ(165.5,IE,1219)
- +17 DO P
- if EX=U
- QUIT
- +18 WRITE !
- +19 DO P
- if EX=U
- QUIT
- +20 WRITE !," 15. USUAL OCCUPATION.............: ",$$OCCUP^ONCACDU1(ONCOPA)
- +21 DO P
- if EX=U
- QUIT
- +22 WRITE !," 16. USUAL INDUSTRY...............: ",$$OCCUP^ONCACDU1(ONCOPA)
- +23 IF IOST?1"C".E
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- if 'Y
- GOTO KILL
- DO HEAD^ONCIPC0
- GOTO II
- +24 DO P
- if EX=U
- QUIT
- II SET TABLE="TUMOR IDENTIFICATION"
- +1 IF IOST'?1"C".E
- WRITE !
- IF ($Y'<(LIN-4))
- DO HEAD^ONCIPC0
- +2 KILL LINE
- SET $PIECE(LINE,"-",20)="-"
- +3 WRITE !?4,TABLE,!?4,LINE
- +4 DO P
- if EX=U
- QUIT
- +5 WRITE !,"17. CLASS OF CASE.................: ",$$GET1^DIQ(165.5,IE,.04)
- +6 DO P
- if EX=U
- QUIT
- +7 WRITE !
- +8 DO P
- if EX=U
- QUIT
- +9 WRITE !,"18. SYMPTOMS:"
- +10 DO P
- if EX=U
- QUIT
- +11 WRITE !," HEADACHE.....................: ",$$GET1^DIQ(165.5,IE,1220)
- +12 DO P
- if EX=U
- QUIT
- +13 WRITE !," NAUSEA/VOMITING..............: ",$$GET1^DIQ(165.5,IE,1221)
- +14 DO P
- if EX=U
- QUIT
- +15 WRITE !," CHANGE IN SENSE OF SMELL AND/"
- +16 DO P
- if EX=U
- QUIT
- +17 WRITE !," OR TASTE....................: ",$$GET1^DIQ(165.5,IE,1222)
- +18 DO P
- if EX=U
- QUIT
- +19 WRITE !," ALTERED ALERTNESS............: ",$$GET1^DIQ(165.5,IE,1223)
- +20 DO P
- if EX=U
- QUIT
- +21 WRITE !," FATIGUE......................: ",$$GET1^DIQ(165.5,IE,1224)
- +22 DO P
- if EX=U
- QUIT
- +23 WRITE !," SPEECH DISTURBANCE...........: ",$$GET1^DIQ(165.5,IE,1225)
- +24 DO P
- if EX=U
- QUIT
- +25 WRITE !," PERSONALITY CHANGES..........: ",$$GET1^DIQ(165.5,IE,1226)
- +26 DO P
- if EX=U
- QUIT
- +27 WRITE !," DEPRESSION...................: ",$$GET1^DIQ(165.5,IE,1227)
- +28 DO P
- if EX=U
- QUIT
- +29 WRITE !," MEMORY LOSS..................: ",$$GET1^DIQ(165.5,IE,1228)
- +30 DO P
- if EX=U
- QUIT
- +31 WRITE !," LACK OF CONCENTRATION........: ",$$GET1^DIQ(165.5,IE,1229)
- +32 DO P
- if EX=U
- QUIT
- +33 WRITE !," DOUBLE VISION................: ",$$GET1^DIQ(165.5,IE,1230)
- +34 DO P
- if EX=U
- QUIT
- +35 WRITE !," OTHER VISUAL DISTURBANCE.....: ",$$GET1^DIQ(165.5,IE,1231)
- +36 DO P
- if EX=U
- QUIT
- +37 WRITE !," DECREASED HEARING............: ",$$GET1^DIQ(165.5,IE,1232)
- +38 DO P
- if EX=U
- QUIT
- +39 WRITE !," VERTIGO......................: ",$$GET1^DIQ(165.5,IE,1233)
- +40 DO P
- if EX=U
- QUIT
- +41 WRITE !," TINNITUS.....................: ",$$GET1^DIQ(165.5,IE,1234)
- +42 DO P
- if EX=U
- QUIT
- +43 WRITE !," NUMBNESS/TINGLING............: ",$$GET1^DIQ(165.5,IE,1235)
- +44 DO P
- if EX=U
- QUIT
- +45 WRITE !," WEAKNESS OR PARALYSIS........: ",$$GET1^DIQ(165.5,IE,1236)
- +46 DO P
- if EX=U
- QUIT
- +47 WRITE !," DIFFICULTY IN COORDINATION/"
- +48 DO P
- if EX=U
- QUIT
- +49 WRITE !," BALANCE.....................: ",$$GET1^DIQ(165.5,IE,1237)
- +50 DO P
- if EX=U
- QUIT
- +51 WRITE !," GENERALIZED SEIZURE..........: ",$$GET1^DIQ(165.5,IE,1238)
- +52 DO P
- if EX=U
- QUIT
- +53 WRITE !," FOCAL SEIZURE................: ",$$GET1^DIQ(165.5,IE,1239)
- +54 DO P
- if EX=U
- QUIT
- +55 WRITE !," BLADDER INCONTINENCE.........: ",$$GET1^DIQ(165.5,IE,1240)
- +56 DO P
- if EX=U
- QUIT
- +57 WRITE !," BOWEL INCONTINENCE...........: ",$$GET1^DIQ(165.5,IE,1241)
- +58 DO P
- if EX=U
- QUIT
- +59 WRITE !," PAIN (OTHER THAN HEADACHE)...: ",$$GET1^DIQ(165.5,IE,1242)
- +60 DO P
- if EX=U
- QUIT
- +61 WRITE !," WEIGHT CHANGE................: ",$$GET1^DIQ(165.5,IE,1243)
- +62 DO P
- if EX=U
- QUIT
- +63 WRITE !," OTHER........................: ",$$GET1^DIQ(165.5,IE,1244)
- +64 DO P
- if EX=U
- QUIT
- +65 WRITE !
- +66 DO P
- if EX=U
- QUIT
- +67 if IOST?1"C".E
- DO HEAD^ONCIPC0
- DO ^ONCIPC8A
- KILL ;Kill variables
- +1 KILL EX,IE,LIN,ONDATE,X,Y
- +2 QUIT
- P ;Print
- +1 IF ($Y'<(LIN-1))
- Begin DoDot:1
- +2 IF IOST?1"C".E
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET EX=U
- QUIT
- +3 DO HEAD^ONCIPC0
- QUIT
- End DoDot:1
- if EX=U
- QUIT
- +4 QUIT
- TASK ;Queue a task
- +1 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
- +2 SET ZTRTN="PRT^ONCIPC8"
- SET ZTREQ="@"
- SET ZTSAVE("ZTREQ")=""
- +3 SET ZTDESC="Print Intracranial & CNS PCE"
- +4 FOR V2=1:1
- SET V1=$PIECE(ONCOLST,"^",V2)
- if V1=""
- QUIT
- SET ZTSAVE(V1)=""
- +5 DO ^%ZTLOAD
- DO ^%ZISC
- USE IO
- WRITE !,"Request Queued",!
- +6 KILL V1,V2,ONCOLST,ZTSK
- QUIT
