ONCOAID ;Hines OIFO/GWB - Patient Demographic Information ;6/23/10
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
DEM ;Display demographic information
D SET S X=ONCOVP,DFN=$P(X,";",1),FIL=$P(X,";",2)
S ONC="^"_FIL_DFN
S ONCO=ONC_",0)" S ONCO0=$S($D(@ONCO):^(0),1:"") I ONCO0="" W "??dangling pointer" Q
FIL ;name file
S FN=$S(FIL="DPT(":"Patient",1:"Referral")
SN S SN=$P(ONCO0,U,9),ONCOMR=SN,ONCOSN=$E(SN,1,3)_"-"_$E(SN,4,5)_"-"_$E(SN,6,9)
DB S Y=$P(ONCO0,U,3) D DD^%DT S ONCODB=Y
PB S POB=$P(ONCO0,U,12),SOB=$S(POB="":"",1:$P($G(^DIC(5,POB,0)),U))
;
;Translate SEX and RACE
SX S SX=$P(ONCO0,U,2),SEX=$S(SX="M":"Male",SX="F":"Female",1:"Not Stated")
RC S R=$P(ONCO0,U,6),RC=$G(^ONCO(164.46,+R,0)),R=$P(RC,U,2),RCE=$P(RC,U)
S RCE=$S(RC="":"Not Stated",1:RCE)
;
MS ;marital status
S MS=$P(ONCO0,U,5),MS=$S(MS=1:4,MS=4:5,MS=5:3,MS=6:1,MS=7:9,1:MS) ;SAVE for abstract
XD S ONCO=ONC_",.35)" S Y=$S($D(@ONCO):$P(@ONCO,U),1:"") I Y'="" S ONCODD=Y D DD^%DT S XD=Y ; ONC defined in paragraph DEM above
AD S ONCO=ONC_",.11)" S YY=$S($D(@ONCO):^(.11),1:"") I YY F J=1:1:7 S A(J)=$P(YY,U,J) K:A(J)="" A(J) ; ONC defined in paragraph DEM above
TL S ONCO=ONC_",.13)" I $D(@ONCO) S TL=$P(^(.13),U,1) ; ONC defined in paragraph DEM above
W W !!,?6,"The following information is contained in the ",FN," file"
W !?12,"NOT editable - See your MAS department IF in error",!
N W !?20,"Name: ",ONCONM,!
1 W !,"DOB: ",ONCODB W:$D(A(1)) ?31,"Address: ",A(1) W:$D(A(2)) " ",A(2)
2 W !,"SSN: ",ONCOSN W:$D(A(4)) ?40,A(4) W:$D(A(5)) ",",$P(^DIC(5,A(5),0),U)
4 W !,"SEX: ",SEX W:$D(CT) ?40,"County: ",CT
W !,"POB: ",$S(SOB="":"Not Stated",1:SOB) W:$D(TL) ?40,TL
W:$D(XD) !,"DEATH: ",XD
TT S D0=ONCOD0 W ! D NOK^ONCOCON
G PAT
;
PAT S ONCOSX=$S(SX="M":1,SX="F":2,1:9)
XX S RCC=$S(R="":99,R<4:R,R=4:2,R=6:1,1:99)
POB S X=SOB,DIC="^ONCO(165.2,",DIC(0)="ZM" D ^DIC K DIC,X
S ONCOPB=$S(Y=-1:999,+Y=633:33,1:+Y)
S $P(^ONCO(160,ONCOD0,0),U,5,8)=ONCOPB_U_ONCORC_U_ONCOET_U_ONCOSX
S:$D(ONCODD) $P(^ONCO(160,ONCOD0,1),U,8)=ONCODD
D KILL Q
;
SET S (POB,ET,YY,TL,ONCODB,ONCODD,ONCOET,ONCOMR,ONCOPB,ONCORC,ONCOSN,ONCOSX)=""
N SEX
Q
;
KILL ;Kill variables
K A,D0,CT,DFN,DIC,ET,FIL,FN,J,MS,ONC,ONCO,ONCO0,ONCODB,ONCODD,ONCOET
K ONCOMR,ONCOPB,ONCORC,ONCOSN,ONCOSX,ONCOVP,POB,R,RC,RCC,RCE,SN,SOB,SX
K TL,X,XD,Y,YY
Q
;
CLEANUP ;Cleanup
K ONCOD0,ONCONM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOAID 2400 printed Oct 16, 2024@18:24:50 Page 2
ONCOAID ;Hines OIFO/GWB - Patient Demographic Information ;6/23/10
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
DEM ;Display demographic information
+1 DO SET
SET X=ONCOVP
SET DFN=$PIECE(X,";",1)
SET FIL=$PIECE(X,";",2)
+2 SET ONC="^"_FIL_DFN
+3 SET ONCO=ONC_",0)"
SET ONCO0=$SELECT($DATA(@ONCO):^(0),1:"")
IF ONCO0=""
WRITE "??dangling pointer"
QUIT
FIL ;name file
+1 SET FN=$SELECT(FIL="DPT(":"Patient",1:"Referral")
SN SET SN=$PIECE(ONCO0,U,9)
SET ONCOMR=SN
SET ONCOSN=$EXTRACT(SN,1,3)_"-"_$EXTRACT(SN,4,5)_"-"_$EXTRACT(SN,6,9)
DB SET Y=$PIECE(ONCO0,U,3)
DO DD^%DT
SET ONCODB=Y
PB SET POB=$PIECE(ONCO0,U,12)
SET SOB=$SELECT(POB="":"",1:$PIECE($GET(^DIC(5,POB,0)),U))
+1 ;
+2 ;Translate SEX and RACE
SX SET SX=$PIECE(ONCO0,U,2)
SET SEX=$SELECT(SX="M":"Male",SX="F":"Female",1:"Not Stated")
RC SET R=$PIECE(ONCO0,U,6)
SET RC=$GET(^ONCO(164.46,+R,0))
SET R=$PIECE(RC,U,2)
SET RCE=$PIECE(RC,U)
+1 SET RCE=$SELECT(RC="":"Not Stated",1:RCE)
+2 ;
MS ;marital status
+1 ;SAVE for abstract
SET MS=$PIECE(ONCO0,U,5)
SET MS=$SELECT(MS=1:4,MS=4:5,MS=5:3,MS=6:1,MS=7:9,1:MS)
XD ; ONC defined in paragraph DEM above
SET ONCO=ONC_",.35)"
SET Y=$SELECT($DATA(@ONCO):$PIECE(@ONCO,U),1:"")
IF Y'=""
SET ONCODD=Y
DO DD^%DT
SET XD=Y
AD ; ONC defined in paragraph DEM above
SET ONCO=ONC_",.11)"
SET YY=$SELECT($DATA(@ONCO):^(.11),1:"")
IF YY
FOR J=1:1:7
SET A(J)=$PIECE(YY,U,J)
if A(J)=""
KILL A(J)
TL ; ONC defined in paragraph DEM above
SET ONCO=ONC_",.13)"
IF $DATA(@ONCO)
SET TL=$PIECE(^(.13),U,1)
W WRITE !!,?6,"The following information is contained in the ",FN," file"
+1 WRITE !?12,"NOT editable - See your MAS department IF in error",!
N WRITE !?20,"Name: ",ONCONM,!
1 WRITE !,"DOB: ",ONCODB
if $DATA(A(1))
WRITE ?31,"Address: ",A(1)
if $DATA(A(2))
WRITE " ",A(2)
2 WRITE !,"SSN: ",ONCOSN
if $DATA(A(4))
WRITE ?40,A(4)
if $DATA(A(5))
WRITE ",",$PIECE(^DIC(5,A(5),0),U)
4 WRITE !,"SEX: ",SEX
if $DATA(CT)
WRITE ?40,"County: ",CT
+1 WRITE !,"POB: ",$SELECT(SOB="":"Not Stated",1:SOB)
if $DATA(TL)
WRITE ?40,TL
+2 if $DATA(XD)
WRITE !,"DEATH: ",XD
TT SET D0=ONCOD0
WRITE !
DO NOK^ONCOCON
+1 GOTO PAT
+2 ;
PAT SET ONCOSX=$SELECT(SX="M":1,SX="F":2,1:9)
XX SET RCC=$SELECT(R="":99,R<4:R,R=4:2,R=6:1,1:99)
POB SET X=SOB
SET DIC="^ONCO(165.2,"
SET DIC(0)="ZM"
DO ^DIC
KILL DIC,X
+1 SET ONCOPB=$SELECT(Y=-1:999,+Y=633:33,1:+Y)
+2 SET $PIECE(^ONCO(160,ONCOD0,0),U,5,8)=ONCOPB_U_ONCORC_U_ONCOET_U_ONCOSX
+3 if $DATA(ONCODD)
SET $PIECE(^ONCO(160,ONCOD0,1),U,8)=ONCODD
+4 DO KILL
QUIT
+5 ;
SET SET (POB,ET,YY,TL,ONCODB,ONCODD,ONCOET,ONCOMR,ONCOPB,ONCORC,ONCOSN,ONCOSX)=""
+1 NEW SEX
+2 QUIT
+3 ;
KILL ;Kill variables
+1 KILL A,D0,CT,DFN,DIC,ET,FIL,FN,J,MS,ONC,ONCO,ONCO0,ONCODB,ONCODD,ONCOET
+2 KILL ONCOMR,ONCOPB,ONCORC,ONCOSN,ONCOSX,ONCOVP,POB,R,RC,RCC,RCE,SN,SOB,SX
+3 KILL TL,X,XD,Y,YY
+4 QUIT
+5 ;
CLEANUP ;Cleanup
+1 KILL ONCOD0,ONCONM
