Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCOANC2

ONCOANC2.m

Go to the documentation of this file.
  1. ONCOANC2 ;Hines OIFO/GWB - BUILDS DATA ARRAY FOR NCDB CALL FOR DATA ;7/20/93 10:38
  1. ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
  1. AASTUM ; TUMOR DATA
  1. S AASEQ=$P(AAS1655("N0"),U,6)
  1. I AASEQ?2A,"^AA^BB^CC^DD^EE^FF^GG^HH^II^XX^"'[("^"_AASEQ_"^") S AASEQ="99"
  1. I AASEQ=""!(AASEQ<0)!(AASEQ>99) S AASEQ="99"
  1. S:$L(AASEQ)<2 AASEQ=$E(AASZERO,1,2-$L(AASEQ))_AASEQ
  1. S AASX=$P(AAS1655("N0"),U,16) X AASDTCV S AASDXDT=AASX
  1. S:AASAY>89 AASPS=$$ONCOPS($P(AAS1655("N2"),U))
  1. ;The following is the old logic for Primary Site extraction
  1. I AASAY<90 D
  1. .S AASPS=$P(AAS1655("N2"),U,29),AASPS=$S('$L(AASPS):1999,AASPS<1400!(AASPS>1999):1999,1:AASPS)
  1. .S:"."[AASPS AASPS=$P(AASPS,".")
  1. S AASLAT=$P(AAS1655("N2"),U,8),AASLAT=$S(AASLAT=""!(AASLAT<0)!(AASLAT>4):0,1:AASLAT)
  1. S AASMHIS=$P(AAS1655("N2"),U,30) I AASMHIS'="" S:$L(AASMHIS)<5 AASMHIS=$E(AASZERO,1,5-$L(AASMHIS))_AASMHIS
  1. S:AASMHIS="" AASMHIS=$P(AAS1655("N2"),U,3) S:$L(AASMHIS)<5 AASMHIS=$E(AASZERO,1,5-$L(AASMHIS))_AASMHIS
  1. S:$L(AASMHIS)>5 AASMHIS=$E(AASMHIS,1,5)
  1. S AASGDIF=$P(AAS1655("N2"),U,5) S AASGDIF=$S(AASGDIF=""!(AASGDIF<0)!(AASGDIF>7):9,1:AASGDIF)
  1. S (AASITC,AASMORC)=9
  1. S AASDIA=$P(AAS1655("N2"),U,6) S AASDIA=$S(AASDIA=""!(AASDIA<1)!(AASDIA=3)!(AASDIA>9):9,1:AASDIA)
  1. S AASRPT=$P(AAS1655("N0"),U,10)
  1. S AASRPT=$S(AASRPT=2:1,AASRPT>7!(AASRPT=""):" ",1:AASRPT)
  1. 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
  1. AASHSP ; HOSPITAL-SPECIFIC DATA
  1. S AASACCH=$P(AAS1655("N0"),U,5) S AASACCH=$S(AASACCH="":"000000",$L(AASACCH)<6:$E(AASZERO,1,6-$L(AASACCH))_AASACCH,1:AASACCH)
  1. S AASX=$P(AAS1655("N0"),U,8) X AASDTCV S AASHAD=AASX
  1. S AASX=$P(AAS1655("N0"),U,9) X AASDTCV S AASHDD=AASX
  1. S AASRHSR=$P(AAS1655("N3"),U,38) S AASRHSR=$S(AASRHSR="":"00",1:AASRHSR)
  1. S AASRHRA=$P(AAS1655("N3"),U,6) S AASRHRA=$S(AASRHRA=""!(AASRHRA<0):" ",AASRHRA=6:" ",AASRHRA>9:" ",1:AASRHRA)
  1. S AASRXCH=$P(AAS1655("N3"),U,13) S AASRXCH=$S(AASRXCH=""!(AASRXCH<0)!(AASRXCH>9):" ",AASRXCH>3&(AASRXCH<7):" ",1:AASRXCH)
  1. S AASRST=$P(AAS1655("N3"),U,16) S AASRST=$S(AASRST=""!(AASRST<0)!(AASRST>9):" ",AASRST>3&(AASRST<7):" ",1:AASRST)
  1. S AASRXBR=$P(AAS1655("N3"),U,19)
  1. S:AASRXBR'="" AASRXBR=$P($G(^ONCO(160.5,AASRXBR,0)),U,1)
  1. S AASRXBR=$S(AASRXBR=""!(AASRXBR<0)!(AASRXBR>9):" ",AASRXBR>1&(AASRXBR<7):" ",1:AASRXBR)
  1. S AASROC=$P(AAS1655("N3"),U,25) S AASROC=$S(AASROC=""!(AASROC<0)!(AASROC>9):" ",AASROC>3&(AASROC<6):" ",1:AASROC)
  1. S ^TMP($J,D0,225)=AASACCH_" "_AASHAD_AASHDD_AASCASE_AASRHSR_AASRHRA_AASRXCH_AASRST_AASRXBR_AASROC
  1. G AASTEOD^ONCOANC1
  1. Q
  1. ONCOPS(TMP1) ;
  1. N TMP
  1. S TMP=$G(^ONCO(164,+TMP1,0))
  1. S TMP=$P(TMP,U,2)
  1. Q $S(TMP'?1"C"2N1"."1N:" ",1:$P(TMP,".")_$P(TMP,".",2))
  1. TPREP ;
  1. N NAME,DATA,NEXT,REQ
  1. D:PG=0 HEAD
  1. F NEXT=1:1 D PTNEXT(.NAME,.DATA,.NEXT,.REQ) Q:NEXT=0 Q:$D(ONCOUT) D
  1. .W !,NAME,?50,DATA X ONCOFF Q:$D(ONCOUT)
  1. Q:$D(ONCOUT) I $Y>3 D CFORM
  1. Q
  1. REQREP ;
  1. N NAME,DATA,NEXT,REQ,RECID
  1. F NEXT=1:1 D PTNEXT(.NAME,.DATA,.NEXT,.REQ) Q:+NEXT=0 Q:$D(ONCOUT) D:REQ'=""
  1. .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)
  1. .W !,NAME,?50,"******" X ONCOFF Q:$D(ONCOUT) ;DATA
  1. I $D(RECID) S ONCOECNT=ONCOECNT+1 W ! X ONCOFF Q:$D(ONCOUT) I $Y>3 D CFORM
  1. Q
  1. PTNEXT(NAME,DATA,NEXT,REQ) ;
  1. N START,END,TMP
  1. S TMP=$TEXT(DATA+NEXT^ONCOANCF)
  1. I TMP'="" D
  1. .S NAME=$P($P(TMP,";;",2),U),START=$P(TMP,U,2),END=$P(TMP,U,3)
  1. .S DATA=$$GDATA(START,END),REQ=$P(TMP,U,4) D:REQ[":" CHKOR(.REQ)
  1. .S REQ=$S(REQ="":"",$E(DATA,1,$L(DATA))=$E(AASBLNK,1,$L(DATA)):1,1:"")
  1. S:TMP="" NEXT=0
  1. Q
  1. CHKOR(REQ) ;
  1. N START,END,DATA1
  1. S START=$P($P(REQ,":",2),","),END=$P($P(REQ,":",2),",",2)
  1. S DATA1=$$GDATA(START,END)
  1. S REQ=$S($E(DATA1,1,$L(DATA1))=$E(AASBLNK,1,$L(DATA1)):1,1:"")
  1. Q
  1. GDATA(START,END) ;
  1. N NODE,BASE S (BASE,NODE)=0
  1. 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))
  1. Q $S(+NODE=0:" ",1:$E(^TMP($J,D0,NODE),START-BASE,END-BASE))
  1. CFORM ;
  1. 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
  1. Q
  1. S PG=PG+1 W @IOF,!,"Pg. "_PG,?79-$L(" Oncology ACOS Report "),"Oncology ACOS Report"
  1. I (PG>1),(IOST["C-") W ! Q
  1. W:$D(ONCOREP) !,$$HEDSTAR("Oncology ACOS Report ",77)
  1. W:$D(ONCOREQ) !,$$HEDSTAR("Oncology ACOS Required data Report ",77)
  1. N FFF S $P(FFF,"- ",40)="- " W !,FFF,!
  1. Q
  1. HEDSTAR(X,X1) ; surround text string X with asterisks to length X1
  1. N Y1
  1. S (TY,Y1)="",$P(Y1," ",X1-$L(X)\2-1)=" ",TY=Y1_" "_X_" "
  1. F I=$L(TY):1:X1 S TY=TY_" "
  1. Q TY