49 lines
2.5 KiB
Mathematica
49 lines
2.5 KiB
Mathematica
ONCOAID ;Hines OIFO/GWB-PATIENT DEMOGRAPHIC INFORMATION ;7/20/93
|
|
;;2.11;ONCOLOGY;**23,37**;Mar 07, 1995
|
|
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(^DIC(5,POB,0),U))
|
|
;translate SEX,RACE & code Ethenticity
|
|
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),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
|
|
W4 W !!?10,"************* Oncology Patient file DATA **************"
|
|
G PAT
|
|
CT ;get county from zipcode (may be different from COUNTY).
|
|
K CT S Y=A(6),Y=$O(^VIC(5.11,"B",Y_" ",0)),ZP0=$S($D(^VIC(5.11,+Y,0)):^(0),1:"") Q:ZP0="" S CY=$P(ZP0,U,2),CT=$P(^VIC(5.1,$P(ZP0,U,3),0),U)
|
|
Q
|
|
;
|
|
PAT S ONCOSX=$S(SX="M":1,SX="F":2,1:9)
|
|
;S ONCOET=$S(R="":9,R<3:6,R>2&(R<7):0,R=7:9,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 KIL Q
|
|
;
|
|
SET S (POB,ET,YY,TL,ONCODB,ONCODD,ONCOET,ONCOMR,ONCOPB,ONCORC,ONCOSN,ONCOSX)=""
|
|
Q
|
|
KIL ;Kill Variables
|
|
K A,DOB,CT,CY,DA,DFN,DIC,DIE,DR,ET,ETH,FIL,FN,J,MS,POB,ONC,ONCO,PRT,R,RC,RCC,RCE,SN,SOB,TL,X,XD,XX,Y,YY,ZP0
|
|
Q
|