| 1 | ONCOANC4 ;Hines OIFO/GWB - ACOS DATA TAPE UTILITY FUNCTIONS ;7/20/93
|
---|
| 2 | ;;2.11;ONCOLOGY;**1,25,26**;Mar 07, 1995
|
---|
| 3 | ;
|
---|
| 4 | AASDC(YYYMMDD,ZERO) ; CONVERTS YYYMMDD TO MMDDCCYY
|
---|
| 5 | ; returns blank input as zeros if ZERO defined, else blanks
|
---|
| 6 | ;
|
---|
| 7 | IF (YYYMMDD'="")&(YYYMMDD'?6"0") D I 1 ; non-null input - convert
|
---|
| 8 | . S MMDDCCYY=$E(YYYMMDD,4,5)_$E(YYYMMDD,6,7)_(1700+$E(YYYMMDD,1,3))
|
---|
| 9 | . I $E(MMDDCCYY,1,2)="00" S MMDDCCYY=99_$E(MMDDCCYY,3,8)
|
---|
| 10 | . I $E(MMDDCCYY,3,4)="00" S MMDDCCYY=$E(MMDDCCYY,1,2)_99_$E(MMDDCCYY,5,8)
|
---|
| 11 | . Q
|
---|
| 12 | ELSE D ; null input - return blanks or zeros
|
---|
| 13 | . I '$D(ZERO) S MMDDCCYY=$J("",8) ; blanks
|
---|
| 14 | . E S MMDDCCYY="00000000" ; zeros
|
---|
| 15 | . Q
|
---|
| 16 | ;END IF
|
---|
| 17 | ;
|
---|
| 18 | QUIT MMDDCCYY
|
---|
| 19 | INIT(D0,DATE,SURG,RAD,CHEM,HORM,BIO,OCO,NUMBER) ;Subsequent Therapies
|
---|
| 20 | N TMP,CNT,RCNT S CNT=0,DATE=""
|
---|
| 21 | F S CNT=$O(^ONCO(165.5,D0,4,CNT)) Q:CNT'?1N.N D
|
---|
| 22 | .S TMP($P(^ONCO(165.5,D0,4,CNT,0),U))=^(0)
|
---|
| 23 | .S TMP($P(^ONCO(165.5,D0,4,CNT,0),U),3)=$S('$D(^ONCO(165.5,D0,4,CNT,3)):"",1:^(3))
|
---|
| 24 | F RCNT=1:1:NUMBER S DATE=$O(TMP(DATE)) Q:DATE=""
|
---|
| 25 | D @$S(DATE="":"NOENT",1:"ENTREE")
|
---|
| 26 | S DATE=$$AASDC(DATE)
|
---|
| 27 | Q
|
---|
| 28 | NOENT ; 'NUMBER' Subsequent therapy does not exist
|
---|
| 29 | S SURG=" "
|
---|
| 30 | S (RAD,CHEM,HORM,BIO,OCO)=" ",NUMBER=0
|
---|
| 31 | Q
|
---|
| 32 | ENTREE ;
|
---|
| 33 | S SURG=$P(TMP(DATE),U,4) S SURG=$S($G(SURG):SURG,1:" ")
|
---|
| 34 | S:($L(SURG)<2) SURG="0"_SURG
|
---|
| 35 | S RAD=$P(TMP(DATE),U,5) S RAD=$S($G(RAD):RAD,1:" ")
|
---|
| 36 | S CHEM=$P(TMP(DATE),U,6) S CHEM=$S($G(CHEM):CHEM,1:" ")
|
---|
| 37 | S HORM=$P(TMP(DATE),U,7) S HORM=$S($G(HORM):HORM,1:" ")
|
---|
| 38 | S BIO=$P(TMP(DATE,3),U,19) S BIO=$S($G(BIO):BIO,1:" ")
|
---|
| 39 | S OCO=$P(TMP(DATE),U,9) S OCO=$S($G(OCO):OCO,1:" ")
|
---|
| 40 | Q
|
---|
| 41 | RSAR ;RACE,SEX,AGE,RELIGION
|
---|
| 42 | S AASRAC=$S($P(AAS160("N0"),U,6)]"":$P(AAS160("N0"),U,6),1:99)
|
---|
| 43 | S AASRAC=$S(AASRAC>13&(AASRAC<20)!(AASRAC>22&(AASRAC<25))!(AASRAC>28&(AASRAC<30))!(AASRAC>32&(AASRAC<96)):99,1:AASRAC)
|
---|
| 44 | S AASRAC=$S(AASRAC<1!(AASRAC>99):99,1:AASRAC)
|
---|
| 45 | S:$L(AASRAC)<2 AASRAC=$E(AASZERO,1,2-$L(AASRAC))_AASRAC
|
---|
| 46 | S AASRCS=3,AASPAN=$P(AAS160("N0"),U,7),AASPAN=$S(AASPAN=""!(AASPAN<0)!(AASPAN>9):9,AASPAN>6&(AASPAN<9):9,1:AASPAN)
|
---|
| 47 | S AASEX=$P(AAS160("N0"),U,8),AASEX=$S(AASEX=""!(AASEX<1)!(AASEX>9):9,AASEX>4&(AASEX<9):9,1:AASEX)
|
---|
| 48 | D AGE^ONCOCOM S AASAGE=$S(X=""!(X<0)!(X>999):"000",1:X)
|
---|
| 49 | S:$L(AASAGE)<3 AASAGE=$E(AASZERO,1,3-$L(AASAGE))_AASAGE
|
---|
| 50 | S AASX=$S(+$P(AASDPT,U,3):$P(AASDPT,U,3),1:"") X AASDTCV S AASDOB=AASX
|
---|
| 51 | S AASPOB=$S($P(AAS160("N0"),U,5)'="":$P(AAS160("N0"),U,5),1:999)
|
---|
| 52 | S:$L(AASPOB)<3 AASPOB=$E(AASZERO,1,3-$L(AASPOB))_AASPOB
|
---|
| 53 | S AASREL=99
|
---|
| 54 | S ^TMP($J,D0,76)=^TMP($J,D0,76)_AASMS_AASRAC_AASRCS_AASRCS_AASPAN_AASEX_AASAGE_AASDOB
|
---|
| 55 | S ^TMP($J,D0,149)=AASPOB_AASREL_$E(AASBLNK,1,26)
|
---|
| 56 | Q
|
---|
| 57 | NAME ;First, and Last Names, Middle initials, and SSN Extracted
|
---|
| 58 | S AASNM=$P(PD0,U),AASFSSN=$P(PD0,U,9),$P(AASNMBLK," ",16)=""
|
---|
| 59 | S:AASFSSN'?9N AASFSSN=999999999
|
---|
| 60 | S AASNMF=$TR($P(AASNM,",",2),".,-'_")
|
---|
| 61 | S AASNML=$TR($P(AASNM,","),"., -'_"),AASNML=$E(AASNML_AASNMBLK,1,15)
|
---|
| 62 | S AASNMM=$E($P(AASNMF," ",2),1) S:AASNMM'?1U AASNMM=" "
|
---|
| 63 | S AASNMF=$P(AASNMF," "),AASNMF=$E(AASNMF_AASNMBLK,1,14)
|
---|
| 64 | S $P(AASNMBLK," ",80)=""
|
---|
| 65 | S ^TMP($J,D0,628)=$E(AASNMBLK,1,78),^TMP($J,D0,706)=$E(AASNMBLK,1,78)
|
---|
| 66 | S ^TMP($J,D0,784)=$E(AASNMBLK,1,78),^TMP($J,D0,850)=$E(AASNMBLK,1,66)
|
---|
| 67 | S ^TMP($J,D0,925)=AASNML_AASNMF_AASNMM_$E(AASNMBLK,1,44)
|
---|
| 68 | S AASDXCIT=$E($P(AAS1655("N1"),U),1,25)
|
---|
| 69 | S AASDXCIT=AASDXCIT_$E(AASNMBLK,1,25-$L(AASDXCIT))
|
---|
| 70 | S ^TMP($J,D0,1000)=$E(AASNMBLK,1,32)_AASFSSN_AASDXCIT_$E(AASNMBLK,1,10)
|
---|