- ONCOCOF ;HINES OIFO/GWB - [RS Registry Summary Reports - Follow Up] ;06/23/10
- ;;2.2;ONCOLOGY;**1,13,17**;Jul 31, 2013;Build 6
- ;
- FR ;[RS Registry Summary Reports - Follow Up]
- N AA,AB,AC,AD,AE,AF,AG,AN,AS,BEH,CC,MO,ONCODF,PA,PB,PC,PD,PE,PL,PP,PSFC
- N SFC,SITECODE,SITENAME,SUMSTG,T,VV,P100,ONCFDT,ROLDT
- S DIC=164.2,DIC(0)="O"
- D ^DIC K DIC,X
- K ^TMP($J)
- S (T,AB,AC,AD,AS,AF,AN,AA,CC,P100,AE)=0
- D TOTCASE
- S CC=AA
- S X0=0 F S X0=$O(^TMP($J,X0)) Q:X0'>0 D
- .S ST=$P($G(^ONCO(165.5,X0,0)),U)
- .S MO=$$HIST^ONCFUNC(X0)
- .S DATEDX=$P($G(^ONCO(165.5,X0,0)),U,16)
- .D SUB
- S (AB,AC,AE,AF)=0
- S X0=0 F S X0=$O(^TMP($J,X0)) Q:X0'>0 S PP=$P(^ONCO(165.5,X0,0),U,2),VV=$G(^ONCO(160,PP,1)),ONCODF=$P(VV,U,2),AS=$P(VV,U,7),VV=$P(VV,U) D F
- S T=CC-AF-P100 ;patch #17, total cases minus foreign res minus pat > 100 y/o
- S FR=T_U_AB_U_AC_U_AS
- S SFC=AB+AD,AC=T-AB,AE=AC-AD
- I T S PB=$J(AB/T,0,2)*100,PL=$J(AE/T,0,2)*100
- E S (PB,PC,PL)="N/A" ;avoid division by zero
- I T S PC=$J(AC/T,0,2)*100
- E S PC="N/A" ;avoid division by zero
- I T S PA=$J(AE/T,0,2)*100
- E S PA="N/A"
- ;S AD=AD-AB-AF-P100
- I T S PD=$J(AD/T,0,2)*100
- E S PD="N/A"
- S SFC=AB+AD
- I T S PSFC=$J(SFC/T,0,2)*100 ;avoid division by zero
- E S PSFC="N/A"
- S AE=AC-AD
- I T S PE=$J(AE/T,0,2)*100
- E S PE="N/A"
- S FR=FR_U_AF_U_AN_U_AA_U_AB_U_AC_U_PC_U_PB_U_AD_U_PD_U_AE_U_PE_U_PA_U_PL_U_SFC_U_PSFC_U_CC_U_P100
- S AS=$O(^ONCO(160.1,"C",DUZ(2),0))
- I AS="" S AS=$O(^ONCO(160.1,0))
- S ^ONCO(160.1,AS,"FR")=FR
- N IOPH
- I ONCOS("F")=1 S DIC=160.2,DIC(0)="",X="FOLLOWUP RATE REPORT 1" D ^DIC K DIC,X
- I ONCOS("F")=2 S DIC=160.2,DIC(0)="",X="FOLLOWUP RATE REPORT" D ^DIC K DIC,X
- S IOP=ION
- S DIWF="^ONCO(160.2,"_(+Y)_",1,",DIWF(1)="160.1"
- S BY="NUMBER"
- S (FR,TO)=$O(^ONCO(160.1,"C",DUZ(2),0))
- I FR="" S (FR,TO)=$O(^ONCO(160.1,0))
- W !!
- D EN2^DIWF K DIWF,BY,FR,TO S IOP=ION D ^%ZIS
- I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR ; I 'Y S EX=U Q
- K EROLDT,SROLDT,COCDATE,PA,PB,PC,PD,PE,PL,X0
- Q
- ;
- TOTCASE ;AA = Analytic (CLASS OF CASE 00-22)
- ;AN = Non-analytic (CLASS OF CASE 23-99)
- N COC,DATEDX,EOF,MINUS5,ONCOPARS,REFDATE,VASITE,XD0,XD1,ONCOCDT,ONCORDT,ONCOCOC,ONCOCDTP,ONCORDTP
- S VASITE=$O(^ONCO(160.1,"C",DUZ(2),0))
- I VASITE="" S VASITE=$O(^ONCO(160.1,0))
- S (ONCOCDT,ONCOCDTP,ONCORDTP,ONCORDT,SROLDT,EROLDT)=""
- S ONCOCOC=$G(^ONCO(160.1,VASITE,7))
- S (ROLDT,ONCOCDT,COCDATE)=$P(ONCOCOC,U,3)
- S:$G(COCDATE) ONCOCDTP=$E(ONCOCDT,4,5)_"/"_$E(ONCOCDT,6,7)_"/"_($E(ONCOCDT,1,3)+1700)
- I COCDATE="" S ONCOPARS=$G(^ONCO(160.1,VASITE,0)),(ROLDT,ONCOCDT,ONCORDT)=$P(ONCOPARS,U,4)
- S:$G(ONCORDT) ONCORDTP=$E(ONCORDT,4,5)_"/"_$E(ONCORDT,6,7)_"/"_($E(ONCORDT,1,3)+1700)
- S ROLDT=$E(ROLDT,1,1)_$E(ROLDT,2,3)_"0000"
- S SROLDT=DT-170000,EROLDT=DT-20000
- S SROLDT=$E(SROLDT,1,1)_$E(SROLDT,2,3)_"0000"
- I ROLDT>SROLDT S SROLDT=ROLDT
- S EROLDT=$E(EROLDT,1,1)_$E(EROLDT,2,3)_"0000"
- I ONCOS("F")=2 D
- .S SROLDT=DT-70000,SROLDT=$E(SROLDT,1,1)_$E(SROLDT,2,3)_"0000"
- .I ROLDT>SROLDT S SROLDT=ROLDT
- S XD0=SROLDT,EOF=0
- ;
- F D Q:EOF
- .S XD1=""
- .F S XD1=$O(^ONCO(165.5,"ADX",XD0,XD1)) Q:'XD1 I $$DIV^ONCFUNC(XD1)=DUZ(2) D
- ..I $P($G(^ONCO(165.5,XD1,7)),U,2)'=3 Q ;patch #17, only process completed cases.
- ..S DATEDX=$P($G(^ONCO(165.5,XD1,0)),U,16)
- ..I ((DATEDX<SROLDT)!(DATEDX>EROLDT)) Q
- ..S COC=$E($$GET1^DIQ(165.5,XD1,.04),1,2)
- ..I (((COC<10)!((COC>14)&(COC<20)))!(COC>23)) Q ;P17, only class of case 10-14 and 20-22 included.
- ..E S AA=AA+1,^TMP($J,XD1)=""
- .S XD0=$O(^ONCO(165.5,"ADX",XD0)),CC=AA
- .I 'XD0 S EOF=1
- Q
- ;
- SUB ;Subtract patient > 100 y/o
- ;
- N ONCAGE,ONCPT,LY,L365,IE160
- S (LY,L365)=0
- S IE160=$P(^ONCO(165.5,X0,0),U,2)
- S ONCPT=$P(^ONCO(160,IE160,0),";",1)
- S ONCAGE=$$PTAGE(ONCPT,DT) I ONCAGE>100 S P100=P100+1 D KILL Q
- Q
- ;
- PTAGE(DFN,DT) ;get pt age, supported IA=#10061
- N ONCDAY,VADM
- S:DT="" DT=$$DT^XLFDT()
- D DEM^VADPT
- S ONCDAY=$$FMDIFF^XLFDT(DT,$P(VADM(3),"^"),3)
- Q ONCDAY\365.25
- ;
- F ;Subtract NEXT FOLLOW-UP SOURCE (160.04,6) = 8
- ;Foreign residents (not followed)
- ;Subtract STATUS = 0 (Dead) and LTF (Lost to follow-up)
- N FS,LC,X1,X2
- I VV&'AS S X1=$O(^ONCO(160,PP,"F","AA",0)) I X1'="" S LC=$O(^(X1,0)),FS=$P(^ONCO(160,PP,"F",LC,0),U,6) I FS=8 S AF=AF+1,AA=AA-1 D KILL Q
- I 'VV S AB=AB+1 D KILL Q
- S IE160=$P(^ONCO(165.5,X0,0),U,2)
- S X1=$O(^ONCO(160,IE160,"F","AA",0)) I X1'="" S LC=$O(^(X1,0)),LY=$P(^ONCO(160,IE160,"F",LC,0),U,1)
- I $G(LY) S X2=LY,X1=DT D ^%DTC S L365=X
- I $G(L365) I (L365<456) S AD=AD+1
- Q
- ;
- KILL ;Remove non-reportable entry
- K ^TMP($J,X0)
- Q
- ;
- MTS ;MULTIPLE TUMOR STATUS (DEATH) (160,70) 'COMPUTED-FIELD' EXPRESSION
- ;MULTIPLE PRIMARY STATUS (160.04,9) 'COMPUTED-FIELD' EXPRESSION
- ;Displays SITE/GP (165.5,.01): LAST TUMOR STATUS (165.5,95)
- Q:$P($G(^ONCO(160,D0,1)),U,1)
- N PD0,ST,TS
- I '$D(^ONCO(165.5,"C",D0)) W !,"No primaries for this patient" Q
- S PD0=0
- F S PD0=$O(^ONCO(165.5,"C",D0,PD0)) Q:PD0'>0 I $$DIV^ONCFUNC(PD0)=DUZ(2) D
- .S ST=$P(^ONCO(164.2,$P(^ONCO(165.5,PD0,0),U,1),0),U,1)
- .S TS=+$P($G(^ONCO(165.5,PD0,7)),U,6)
- .S TS=$P($G(^ONCO(164.42,TS,0)),U,1)
- .W !,ST_": "_TS
- Q
- ;
- NM ;HOSPITAL NAME (160,1000) 'COMPUTED-FIELD' EXPRESSION
- N XD0
- S XD0=$O(^ONCO(160.1,"C",DUZ(2),0))
- I XD0="" S XD0=$O(^ONCO(160.1,0))
- I XD0'="" S X=$P(^ONCO(160.1,XD0,0),U,1)
- Q
- ;
- ADD ;HOSPITAL STREET ADDRESS (160,1001) 'COMPUTED-FIELD' EXPRESSION
- N XD0
- S XD0=$O(^ONCO(160.1,"C",DUZ(2),0))
- I XD0="" S XD0=$O(^ONCO(160.1,0))
- I XD0'="" S X=$P(^ONCO(160.1,XD0,0),U,2)
- Q
- ;
- ZIP ;HOSPITAL CITY,ST ZIP (160,1002) 'COMPUTED-FIELD' EXPRESSION
- N CITY,STATE,STP,XD0,ZIP
- S XD0=$O(^ONCO(160.1,"C",DUZ(2),0))
- I XD0="" S XD0=$O(^ONCO(160.1,0))
- I XD0'="" D
- .S ZIP=$P(^ONCO(160.1,XD0,0),U,3)
- .S ZIP1=$$GET1^DIQ(160.1,XD0,.03)
- .S CITY=$$GET1^DIQ(5.11,ZIP,1)
- .S STATE=$$GET1^DIQ(5.11,ZIP,3)
- .S X=CITY_", "_STATE_" "_ZIP1
- Q
- ;
- ZIP1 ;CITY,ST ZIP (160.1,.031) 'COMPUTED-FIELD' EXPRESSION
- N CITY,STATE,ZIP,ZIP1
- S ZIP=$P(^ONCO(160.1,D0,0),U,3)
- S ZIP1=$$GET1^DIQ(160.1,D0,.03)
- S CITY=$$GET1^DIQ(5.11,ZIP,1)
- S STATE=$$GET1^DIQ(5.11,ZIP,3)
- S X=CITY_", "_STATE_" "_ZIP1
- Q
- ;
- CLEANUP ;Cleanup
- K D0,DATEDX,ONCOS,Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOCOF 6234 printed Jan 18, 2025@03:25:46 Page 2
- ONCOCOF ;HINES OIFO/GWB - [RS Registry Summary Reports - Follow Up] ;06/23/10
- +1 ;;2.2;ONCOLOGY;**1,13,17**;Jul 31, 2013;Build 6
- +2 ;
- FR ;[RS Registry Summary Reports - Follow Up]
- +1 NEW AA,AB,AC,AD,AE,AF,AG,AN,AS,BEH,CC,MO,ONCODF,PA,PB,PC,PD,PE,PL,PP,PSFC
- +2 NEW SFC,SITECODE,SITENAME,SUMSTG,T,VV,P100,ONCFDT,ROLDT
- +3 SET DIC=164.2
- SET DIC(0)="O"
- +4 DO ^DIC
- KILL DIC,X
- +5 KILL ^TMP($JOB)
- +6 SET (T,AB,AC,AD,AS,AF,AN,AA,CC,P100,AE)=0
- +7 DO TOTCASE
- +8 SET CC=AA
- +9 SET X0=0
- FOR
- SET X0=$ORDER(^TMP($JOB,X0))
- if X0'>0
- QUIT
- Begin DoDot:1
- +10 SET ST=$PIECE($GET(^ONCO(165.5,X0,0)),U)
- +11 SET MO=$$HIST^ONCFUNC(X0)
- +12 SET DATEDX=$PIECE($GET(^ONCO(165.5,X0,0)),U,16)
- +13 DO SUB
- End DoDot:1
- +14 SET (AB,AC,AE,AF)=0
- +15 SET X0=0
- FOR
- SET X0=$ORDER(^TMP($JOB,X0))
- if X0'>0
- QUIT
- SET PP=$PIECE(^ONCO(165.5,X0,0),U,2)
- SET VV=$GET(^ONCO(160,PP,1))
- SET ONCODF=$PIECE(VV,U,2)
- SET AS=$PIECE(VV,U,7)
- SET VV=$PIECE(VV,U)
- DO F
- +16 ;patch #17, total cases minus foreign res minus pat > 100 y/o
- SET T=CC-AF-P100
- +17 SET FR=T_U_AB_U_AC_U_AS
- +18 SET SFC=AB+AD
- SET AC=T-AB
- SET AE=AC-AD
- +19 IF T
- SET PB=$JUSTIFY(AB/T,0,2)*100
- SET PL=$JUSTIFY(AE/T,0,2)*100
- +20 ;avoid division by zero
- IF '$TEST
- SET (PB,PC,PL)="N/A"
- +21 IF T
- SET PC=$JUSTIFY(AC/T,0,2)*100
- +22 ;avoid division by zero
- IF '$TEST
- SET PC="N/A"
- +23 IF T
- SET PA=$JUSTIFY(AE/T,0,2)*100
- +24 IF '$TEST
- SET PA="N/A"
- +25 ;S AD=AD-AB-AF-P100
- +26 IF T
- SET PD=$JUSTIFY(AD/T,0,2)*100
- +27 IF '$TEST
- SET PD="N/A"
- +28 SET SFC=AB+AD
- +29 ;avoid division by zero
- IF T
- SET PSFC=$JUSTIFY(SFC/T,0,2)*100
- +30 IF '$TEST
- SET PSFC="N/A"
- +31 SET AE=AC-AD
- +32 IF T
- SET PE=$JUSTIFY(AE/T,0,2)*100
- +33 IF '$TEST
- SET PE="N/A"
- +34 SET FR=FR_U_AF_U_AN_U_AA_U_AB_U_AC_U_PC_U_PB_U_AD_U_PD_U_AE_U_PE_U_PA_U_PL_U_SFC_U_PSFC_U_CC_U_P100
- +35 SET AS=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
- +36 IF AS=""
- SET AS=$ORDER(^ONCO(160.1,0))
- +37 SET ^ONCO(160.1,AS,"FR")=FR
- +38 NEW IOPH
- +39 IF ONCOS("F")=1
- SET DIC=160.2
- SET DIC(0)=""
- SET X="FOLLOWUP RATE REPORT 1"
- DO ^DIC
- KILL DIC,X
- +40 IF ONCOS("F")=2
- SET DIC=160.2
- SET DIC(0)=""
- SET X="FOLLOWUP RATE REPORT"
- DO ^DIC
- KILL DIC,X
- +41 SET IOP=ION
- +42 SET DIWF="^ONCO(160.2,"_(+Y)_",1,"
- SET DIWF(1)="160.1"
- +43 SET BY="NUMBER"
- +44 SET (FR,TO)=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
- +45 IF FR=""
- SET (FR,TO)=$ORDER(^ONCO(160.1,0))
- +46 WRITE !!
- +47 DO EN2^DIWF
- KILL DIWF,BY,FR,TO
- SET IOP=ION
- DO ^%ZIS
- +48 ; I 'Y S EX=U Q
- IF $EXTRACT(IOST,1,2)="C-"
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Enter RETURN to continue"
- DO ^DIR
- +49 KILL EROLDT,SROLDT,COCDATE,PA,PB,PC,PD,PE,PL,X0
- +50 QUIT
- +51 ;
- TOTCASE ;AA = Analytic (CLASS OF CASE 00-22)
- +1 ;AN = Non-analytic (CLASS OF CASE 23-99)
- +2 NEW COC,DATEDX,EOF,MINUS5,ONCOPARS,REFDATE,VASITE,XD0,XD1,ONCOCDT,ONCORDT,ONCOCOC,ONCOCDTP,ONCORDTP
- +3 SET VASITE=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
- +4 IF VASITE=""
- SET VASITE=$ORDER(^ONCO(160.1,0))
- +5 SET (ONCOCDT,ONCOCDTP,ONCORDTP,ONCORDT,SROLDT,EROLDT)=""
- +6 SET ONCOCOC=$GET(^ONCO(160.1,VASITE,7))
- +7 SET (ROLDT,ONCOCDT,COCDATE)=$PIECE(ONCOCOC,U,3)
- +8 if $GET(COCDATE)
- SET ONCOCDTP=$EXTRACT(ONCOCDT,4,5)_"/"_$EXTRACT(ONCOCDT,6,7)_"/"_($EXTRACT(ONCOCDT,1,3)+1700)
- +9 IF COCDATE=""
- SET ONCOPARS=$GET(^ONCO(160.1,VASITE,0))
- SET (ROLDT,ONCOCDT,ONCORDT)=$PIECE(ONCOPARS,U,4)
- +10 if $GET(ONCORDT)
- SET ONCORDTP=$EXTRACT(ONCORDT,4,5)_"/"_$EXTRACT(ONCORDT,6,7)_"/"_($EXTRACT(ONCORDT,1,3)+1700)
- +11 SET ROLDT=$EXTRACT(ROLDT,1,1)_$EXTRACT(ROLDT,2,3)_"0000"
- +12 SET SROLDT=DT-170000
- SET EROLDT=DT-20000
- +13 SET SROLDT=$EXTRACT(SROLDT,1,1)_$EXTRACT(SROLDT,2,3)_"0000"
- +14 IF ROLDT>SROLDT
- SET SROLDT=ROLDT
- +15 SET EROLDT=$EXTRACT(EROLDT,1,1)_$EXTRACT(EROLDT,2,3)_"0000"
- +16 IF ONCOS("F")=2
- Begin DoDot:1
- +17 SET SROLDT=DT-70000
- SET SROLDT=$EXTRACT(SROLDT,1,1)_$EXTRACT(SROLDT,2,3)_"0000"
- +18 IF ROLDT>SROLDT
- SET SROLDT=ROLDT
- End DoDot:1
- +19 SET XD0=SROLDT
- SET EOF=0
- +20 ;
- +21 FOR
- Begin DoDot:1
- +22 SET XD1=""
- +23 FOR
- SET XD1=$ORDER(^ONCO(165.5,"ADX",XD0,XD1))
- if 'XD1
- QUIT
- IF $$DIV^ONCFUNC(XD1)=DUZ(2)
- Begin DoDot:2
- +24 ;patch #17, only process completed cases.
- IF $PIECE($GET(^ONCO(165.5,XD1,7)),U,2)'=3
- QUIT
- +25 SET DATEDX=$PIECE($GET(^ONCO(165.5,XD1,0)),U,16)
- +26 IF ((DATEDX<SROLDT)!(DATEDX>EROLDT))
- QUIT
- +27 SET COC=$EXTRACT($$GET1^DIQ(165.5,XD1,.04),1,2)
- +28 ;P17, only class of case 10-14 and 20-22 included.
- IF (((COC<10)!((COC>14)&(COC<20)))!(COC>23))
- QUIT
- +29 IF '$TEST
- SET AA=AA+1
- SET ^TMP($JOB,XD1)=""
- End DoDot:2
- +30 SET XD0=$ORDER(^ONCO(165.5,"ADX",XD0))
- SET CC=AA
- +31 IF 'XD0
- SET EOF=1
- End DoDot:1
- if EOF
- QUIT
- +32 QUIT
- +33 ;
- SUB ;Subtract patient > 100 y/o
- +1 ;
- +2 NEW ONCAGE,ONCPT,LY,L365,IE160
- +3 SET (LY,L365)=0
- +4 SET IE160=$PIECE(^ONCO(165.5,X0,0),U,2)
- +5 SET ONCPT=$PIECE(^ONCO(160,IE160,0),";",1)
- +6 SET ONCAGE=$$PTAGE(ONCPT,DT)
- IF ONCAGE>100
- SET P100=P100+1
- DO KILL
- QUIT
- +7 QUIT
- +8 ;
- PTAGE(DFN,DT) ;get pt age, supported IA=#10061
- +1 NEW ONCDAY,VADM
- +2 if DT=""
- SET DT=$$DT^XLFDT()
- +3 DO DEM^VADPT
- +4 SET ONCDAY=$$FMDIFF^XLFDT(DT,$PIECE(VADM(3),"^"),3)
- +5 QUIT ONCDAY\365.25
- +6 ;
- F ;Subtract NEXT FOLLOW-UP SOURCE (160.04,6) = 8
- +1 ;Foreign residents (not followed)
- +2 ;Subtract STATUS = 0 (Dead) and LTF (Lost to follow-up)
- +3 NEW FS,LC,X1,X2
- +4 IF VV&'AS
- SET X1=$ORDER(^ONCO(160,PP,"F","AA",0))
- IF X1'=""
- SET LC=$ORDER(^(X1,0))
- SET FS=$PIECE(^ONCO(160,PP,"F",LC,0),U,6)
- IF FS=8
- SET AF=AF+1
- SET AA=AA-1
- DO KILL
- QUIT
- +5 IF 'VV
- SET AB=AB+1
- DO KILL
- QUIT
- +6 SET IE160=$PIECE(^ONCO(165.5,X0,0),U,2)
- +7 SET X1=$ORDER(^ONCO(160,IE160,"F","AA",0))
- IF X1'=""
- SET LC=$ORDER(^(X1,0))
- SET LY=$PIECE(^ONCO(160,IE160,"F",LC,0),U,1)
- +8 IF $GET(LY)
- SET X2=LY
- SET X1=DT
- DO ^%DTC
- SET L365=X
- +9 IF $GET(L365)
- IF (L365<456)
- SET AD=AD+1
- +10 QUIT
- +11 ;
- KILL ;Remove non-reportable entry
- +1 KILL ^TMP($JOB,X0)
- +2 QUIT
- +3 ;
- MTS ;MULTIPLE TUMOR STATUS (DEATH) (160,70) 'COMPUTED-FIELD' EXPRESSION
- +1 ;MULTIPLE PRIMARY STATUS (160.04,9) 'COMPUTED-FIELD' EXPRESSION
- +2 ;Displays SITE/GP (165.5,.01): LAST TUMOR STATUS (165.5,95)
- +3 if $PIECE($GET(^ONCO(160,D0,1)),U,1)
- QUIT
- +4 NEW PD0,ST,TS
- +5 IF '$DATA(^ONCO(165.5,"C",D0))
- WRITE !,"No primaries for this patient"
- QUIT
- +6 SET PD0=0
- +7 FOR
- SET PD0=$ORDER(^ONCO(165.5,"C",D0,PD0))
- if PD0'>0
- QUIT
- IF $$DIV^ONCFUNC(PD0)=DUZ(2)
- Begin DoDot:1
- +8 SET ST=$PIECE(^ONCO(164.2,$PIECE(^ONCO(165.5,PD0,0),U,1),0),U,1)
- +9 SET TS=+$PIECE($GET(^ONCO(165.5,PD0,7)),U,6)
- +10 SET TS=$PIECE($GET(^ONCO(164.42,TS,0)),U,1)
- +11 WRITE !,ST_": "_TS
- End DoDot:1
- +12 QUIT
- +13 ;
- NM ;HOSPITAL NAME (160,1000) 'COMPUTED-FIELD' EXPRESSION
- +1 NEW XD0
- +2 SET XD0=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
- +3 IF XD0=""
- SET XD0=$ORDER(^ONCO(160.1,0))
- +4 IF XD0'=""
- SET X=$PIECE(^ONCO(160.1,XD0,0),U,1)
- +5 QUIT
- +6 ;
- ADD ;HOSPITAL STREET ADDRESS (160,1001) 'COMPUTED-FIELD' EXPRESSION
- +1 NEW XD0
- +2 SET XD0=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
- +3 IF XD0=""
- SET XD0=$ORDER(^ONCO(160.1,0))
- +4 IF XD0'=""
- SET X=$PIECE(^ONCO(160.1,XD0,0),U,2)
- +5 QUIT
- +6 ;
- ZIP ;HOSPITAL CITY,ST ZIP (160,1002) 'COMPUTED-FIELD' EXPRESSION
- +1 NEW CITY,STATE,STP,XD0,ZIP
- +2 SET XD0=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
- +3 IF XD0=""
- SET XD0=$ORDER(^ONCO(160.1,0))
- +4 IF XD0'=""
- Begin DoDot:1
- +5 SET ZIP=$PIECE(^ONCO(160.1,XD0,0),U,3)
- +6 SET ZIP1=$$GET1^DIQ(160.1,XD0,.03)
- +7 SET CITY=$$GET1^DIQ(5.11,ZIP,1)
- +8 SET STATE=$$GET1^DIQ(5.11,ZIP,3)
- +9 SET X=CITY_", "_STATE_" "_ZIP1
- End DoDot:1
- +10 QUIT
- +11 ;
- ZIP1 ;CITY,ST ZIP (160.1,.031) 'COMPUTED-FIELD' EXPRESSION
- +1 NEW CITY,STATE,ZIP,ZIP1
- +2 SET ZIP=$PIECE(^ONCO(160.1,D0,0),U,3)
- +3 SET ZIP1=$$GET1^DIQ(160.1,D0,.03)
- +4 SET CITY=$$GET1^DIQ(5.11,ZIP,1)
- +5 SET STATE=$$GET1^DIQ(5.11,ZIP,3)
- +6 SET X=CITY_", "_STATE_" "_ZIP1
- +7 QUIT
- +8 ;
- CLEANUP ;Cleanup
- +1 KILL D0,DATEDX,ONCOS,Y