source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOANC2.m@ 1150

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1ONCOANC2 ;Hines OIFO/GWB - BUILDS DATA ARRAY FOR NCDB CALL FOR DATA ;7/20/93 10:38
2 ;;2.11;ONCOLOGY;**1,6,25,26**;Mar 07, 1995
3AASTUM ; TUMOR DATA
4 S AASEQ=$P(AAS1655("N0"),U,6)
5 I AASEQ?2A,"^AA^BB^CC^DD^EE^FF^GG^HH^II^XX^"'[("^"_AASEQ_"^") S AASEQ="99"
6 I AASEQ=""!(AASEQ<0)!(AASEQ>99) S AASEQ="99"
7 S:$L(AASEQ)<2 AASEQ=$E(AASZERO,1,2-$L(AASEQ))_AASEQ
8 S AASX=$P(AAS1655("N0"),U,16) X AASDTCV S AASDXDT=AASX
9 S:AASAY>89 AASPS=$$ONCOPS($P(AAS1655("N2"),U))
10 ;The following is the old logic for Primary Site extraction
11 I AASAY<90 D
12 .S AASPS=$P(AAS1655("N2"),U,29),AASPS=$S('$L(AASPS):1999,AASPS<1400!(AASPS>1999):1999,1:AASPS)
13 .S:"."[AASPS AASPS=$P(AASPS,".")
14 S AASLAT=$P(AAS1655("N2"),U,8),AASLAT=$S(AASLAT=""!(AASLAT<0)!(AASLAT>4):0,1:AASLAT)
15 S AASMHIS=$P(AAS1655("N2"),U,30) I AASMHIS'="" S:$L(AASMHIS)<5 AASMHIS=$E(AASZERO,1,5-$L(AASMHIS))_AASMHIS
16 S:AASMHIS="" AASMHIS=$P(AAS1655("N2"),U,3) S:$L(AASMHIS)<5 AASMHIS=$E(AASZERO,1,5-$L(AASMHIS))_AASMHIS
17 S:$L(AASMHIS)>5 AASMHIS=$E(AASMHIS,1,5)
18 S AASGDIF=$P(AAS1655("N2"),U,5) S AASGDIF=$S(AASGDIF=""!(AASGDIF<0)!(AASGDIF>7):9,1:AASGDIF)
19 S (AASITC,AASMORC)=9
20 S AASDIA=$P(AAS1655("N2"),U,6) S AASDIA=$S(AASDIA=""!(AASDIA<1)!(AASDIA=3)!(AASDIA>9):9,1:AASDIA)
21 S AASRPT=$P(AAS1655("N0"),U,10)
22 S AASRPT=$S(AASRPT=2:1,AASRPT>7!(AASRPT=""):" ",1:AASRPT)
23 S ^TMP($J,D0,149)=^TMP($J,D0,149)_AASEQ_AASDXDT_AASPS_AASLAT_AASMHIS_AASGDIF_AASITC_AASITC_AASMORC_$E(AASBLNK,1,1)_AASDIA_AASRPT_AASACYR_$E(AASBLNK,1,4)_$E(AASZERO,1,2)_AASDXH
24AASHSP ; HOSPITAL-SPECIFIC DATA
25 S AASACCH=$P(AAS1655("N0"),U,5) S AASACCH=$S(AASACCH="":"000000",$L(AASACCH)<6:$E(AASZERO,1,6-$L(AASACCH))_AASACCH,1:AASACCH)
26 S AASX=$P(AAS1655("N0"),U,8) X AASDTCV S AASHAD=AASX
27 S AASX=$P(AAS1655("N0"),U,9) X AASDTCV S AASHDD=AASX
28 S AASRHSR=$P(AAS1655("N3"),U,38) S AASRHSR=$S(AASRHSR="":"00",1:AASRHSR)
29 S AASRHRA=$P(AAS1655("N3"),U,6) S AASRHRA=$S(AASRHRA=""!(AASRHRA<0):" ",AASRHRA=6:" ",AASRHRA>9:" ",1:AASRHRA)
30 S AASRXCH=$P(AAS1655("N3"),U,13) S AASRXCH=$S(AASRXCH=""!(AASRXCH<0)!(AASRXCH>9):" ",AASRXCH>3&(AASRXCH<7):" ",1:AASRXCH)
31 S AASRST=$P(AAS1655("N3"),U,16) S AASRST=$S(AASRST=""!(AASRST<0)!(AASRST>9):" ",AASRST>3&(AASRST<7):" ",1:AASRST)
32 S AASRXBR=$P(AAS1655("N3"),U,19)
33 S:AASRXBR'="" AASRXBR=$P($G(^ONCO(160.5,AASRXBR,0)),U,1)
34 S AASRXBR=$S(AASRXBR=""!(AASRXBR<0)!(AASRXBR>9):" ",AASRXBR>1&(AASRXBR<7):" ",1:AASRXBR)
35 S AASROC=$P(AAS1655("N3"),U,25) S AASROC=$S(AASROC=""!(AASROC<0)!(AASROC>9):" ",AASROC>3&(AASROC<6):" ",1:AASROC)
36 S ^TMP($J,D0,225)=AASACCH_" "_AASHAD_AASHDD_AASCASE_AASRHSR_AASRHRA_AASRXCH_AASRST_AASRXBR_AASROC
37 G AASTEOD^ONCOANC1
38 Q
39ONCOPS(TMP1) ;
40 N TMP
41 S TMP=$G(^ONCO(164,+TMP1,0))
42 S TMP=$P(TMP,U,2)
43 Q $S(TMP'?1"C"2N1"."1N:" ",1:$P(TMP,".")_$P(TMP,".",2))
44TPREP ;
45 N NAME,DATA,NEXT,REQ
46 D:PG=0 HEAD
47 F NEXT=1:1 D PTNEXT(.NAME,.DATA,.NEXT,.REQ) Q:NEXT=0 Q:$D(ONCOUT) D
48 .W !,NAME,?50,DATA X ONCOFF Q:$D(ONCOUT)
49 Q:$D(ONCOUT) I $Y>3 D CFORM
50 Q
51REQREP ;
52 N NAME,DATA,NEXT,REQ,RECID
53 F NEXT=1:1 D PTNEXT(.NAME,.DATA,.NEXT,.REQ) Q:+NEXT=0 Q:$D(ONCOUT) D:REQ'=""
54 .I '$D(RECID) S RECID=$$GDATA(2,6) X ONCOFF Q:$D(ONCOUT) D:PG=0 HEAD W !,"Patient ID",?50,RECID,!,"Primary Site",?50,$$GDATA(119,122)
55 .W !,NAME,?50,"******" X ONCOFF Q:$D(ONCOUT) ;DATA
56 I $D(RECID) S ONCOECNT=ONCOECNT+1 W ! X ONCOFF Q:$D(ONCOUT) I $Y>3 D CFORM
57 Q
58PTNEXT(NAME,DATA,NEXT,REQ) ;
59 N START,END,TMP
60 S TMP=$TEXT(DATA+NEXT^ONCOANCF)
61 I TMP'="" D
62 .S NAME=$P($P(TMP,";;",2),U),START=$P(TMP,U,2),END=$P(TMP,U,3)
63 .S DATA=$$GDATA(START,END),REQ=$P(TMP,U,4) D:REQ[":" CHKOR(.REQ)
64 .S REQ=$S(REQ="":"",$E(DATA,1,$L(DATA))=$E(AASBLNK,1,$L(DATA)):1,1:"")
65 S:TMP="" NEXT=0
66 Q
67CHKOR(REQ) ;
68 N START,END,DATA1
69 S START=$P($P(REQ,":",2),","),END=$P($P(REQ,":",2),",",2)
70 S DATA1=$$GDATA(START,END)
71 S REQ=$S($E(DATA1,1,$L(DATA1))=$E(AASBLNK,1,$L(DATA1)):1,1:"")
72 Q
73GDATA(START,END) ;
74 N NODE,BASE S (BASE,NODE)=0
75 F S NODE=$O(^TMP($J,D0,NODE)) Q:+NODE=0 Q:(((BASE+$L(^(NODE)))>END)!(BASE+$L(^(NODE))=END)) S BASE=BASE+$L(^(NODE))
76 Q $S(+NODE=0:" ",1:$E(^TMP($J,D0,NODE),START-BASE,END-BASE))
77CFORM ;
78 S DN=1,ONCOY="" R:IOST["C-" !!,"Press Return to Continue, '^' to escape: ",ONCOY:DTIME S:'$T ONCOY=U S:ONCOY=U ONCOUT=1,DN=0 Q:$D(ONCOUT) D:DN HEAD^ONCOANC2 K ONCOY
79 Q
80HEAD ;
81 S PG=PG+1 W @IOF,!,"Pg. "_PG,?79-$L(" Oncology ACOS Report "),"Oncology ACOS Report"
82 I (PG>1),(IOST["C-") W ! Q
83 W:$D(ONCOREP) !,$$HEDSTAR("Oncology ACOS Report ",77)
84 W:$D(ONCOREQ) !,$$HEDSTAR("Oncology ACOS Required data Report ",77)
85 N FFF S $P(FFF,"- ",40)="- " W !,FFF,!
86 Q
87HEDSTAR(X,X1) ; surround text string X with asterisks to length X1
88 N Y1
89 S (TY,Y1)="",$P(Y1," ",X1-$L(X)\2-1)=" ",TY=Y1_" "_X_" "
90 F I=$L(TY):1:X1 S TY=TY_" "
91 Q TY
Note: See TracBrowser for help on using the repository browser.