source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOAID.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1ONCOAID ;Hines OIFO/GWB-PATIENT DEMOGRAPHIC INFORMATION ;7/20/93
2 ;;2.11;ONCOLOGY;**23,37**;Mar 07, 1995
3DEM ;Display demographic information
4 D SET S X=ONCOVP,DFN=$P(X,";",1),FIL=$P(X,";",2)
5 S ONC="^"_FIL_DFN
6 S ONCO=ONC_",0)" S ONCO0=$S($D(@ONCO):^(0),1:"") I ONCO0="" W "??dangling pointer" Q
7FIL ;name file
8 S FN=$S(FIL="DPT(":"Patient",1:"Referral")
9SN S SN=$P(ONCO0,U,9),ONCOMR=SN,ONCOSN=$E(SN,1,3)_"-"_$E(SN,4,5)_"-"_$E(SN,6,9)
10DB S Y=$P(ONCO0,U,3) D DD^%DT S ONCODB=Y
11PB S POB=$P(ONCO0,U,12),SOB=$S(POB="":"",1:$P(^DIC(5,POB,0),U))
12 ;translate SEX,RACE & code Ethenticity
13SX S SX=$P(ONCO0,U,2),SEX=$S(SX="M":"Male",SX="F":"Female",1:"Not Stated")
14RC 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)
15MS ;marital status
16 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
17XD 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
18AD 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
19TL S ONCO=ONC_",.13)" I $D(@ONCO) S TL=$P(^(.13),U,1) ; ONC defined in paragraph DEM above
20W W !!,?6,"The following information is contained in the ",FN," file"
21 W !?12,"NOT editable - See your MAS department IF in error",!
22N W !?20,"Name: ",ONCONM,!
231 W !,"DOB: ",ONCODB W:$D(A(1)) ?31,"Address: ",A(1) W:$D(A(2)) " ",A(2)
242 W !,"SSN: ",ONCOSN W:$D(A(4)) ?40,A(4) W:$D(A(5)) ",",$P(^DIC(5,A(5),0),U)
254 W !,"SEX: ",SEX W:$D(CT) ?40,"County: ",CT
26 W !,"POB: ",$S(SOB="":"Not Stated",1:SOB) W:$D(TL) ?40,TL
27 W:$D(XD) !,"DEATH: ",XD
28TT S D0=ONCOD0 W ! D NOK^ONCOCON
29W4 W !!?10,"************* Oncology Patient file DATA **************"
30 G PAT
31CT ;get county from zipcode (may be different from COUNTY).
32 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)
33 Q
34 ;
35PAT S ONCOSX=$S(SX="M":1,SX="F":2,1:9)
36 ;S ONCOET=$S(R="":9,R<3:6,R>2&(R<7):0,R=7:9,1:9)
37XX S RCC=$S(R="":99,R<4:R,R=4:2,R=6:1,1:99)
38POB S X=SOB,DIC="^ONCO(165.2,",DIC(0)="ZM" D ^DIC K DIC,X
39 S ONCOPB=$S(Y=-1:999,+Y=633:33,1:+Y)
40 S $P(^ONCO(160,ONCOD0,0),U,5,8)=ONCOPB_U_ONCORC_U_ONCOET_U_ONCOSX
41 S:$D(ONCODD) $P(^ONCO(160,ONCOD0,1),U,8)=ONCODD
42 D KIL Q
43 ;
44SET S (POB,ET,YY,TL,ONCODB,ONCODD,ONCOET,ONCOMR,ONCOPB,ONCORC,ONCOSN,ONCOSX)=""
45 Q
46KIL ;Kill Variables
47 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
48 Q
Note: See TracBrowser for help on using the repository browser.