| 1 | IMRBPT1 ;HCIOFO-NCA,FT/FAI-DATA EXTRACTION (cont.) ; 12/24/02 9:25am
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;**13,16,19**;Feb 09, 1998
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | GETDAT ; Get All Ancillary Package Data. Called from IMRDAT
|
|---|
| 6 | RX ; Get Outpatient Pharmacy Data
|
|---|
| 7 | S IMRLD=+$P(IMR101,"^",6) ;LAST OPT PHARMACY DATE NOTED
|
|---|
| 8 | D GET^IMRRX(IMRSD,IMRED)
|
|---|
| 9 | S IMRLD=$S(IMRRX>IMRLD:IMRRX,1:IMRLD) S:'IMRLD IMRLD="" ;check FILL DATE against LAST OPT PHARMACY DATE NOTED
|
|---|
| 10 | S $P(IMR101,"^",6,8)=$S(IMRLD>0:IMRLD,1:"")_"^^",$P(IMR101,"^",12)=$S(IMRLD>0:IMRLD,1:"") ;piece 6=LAST OPT PHARMACY DATE NOTED,piece 7=LAST INPT PHARMACY DATE NOTED,piece 8=LAST IV PHARMACY DATE NOTED,piece 12=LAST LIMITED Rx dATE
|
|---|
| 11 | K IMRLD
|
|---|
| 12 | LAB ; Get Lab Data
|
|---|
| 13 | S IMRLD=+$P(IMR101,"^",9),IMRLD1=+$P(IMR101,"^",10) ;piece 9=LAST LABORATORY DATE NOTED,piece 10=LAST MICROBIOLOGY DATE NOTED
|
|---|
| 14 | D CHK^IMRLAB
|
|---|
| 15 | S IMRLD=$S(IMRLAB>IMRLD:IMRLAB,1:IMRLD),IMRLD1=$S(IMRMI>IMRLD1:IMRMI,1:IMRLD1) S:'IMRLD IMRLD=""
|
|---|
| 16 | S $P(IMR101,"^",9,10)=IMRLD_"^"_IMRLD1,$P(IMR101,"^",13)=IMRLD,$P(IMR101,"^",17)=IMRLD1 K IMRLD,IMRLD1 ;piece 13=last limited lab date, piece 17=last limited micro date
|
|---|
| 17 | RAD ; Get Radiology Data
|
|---|
| 18 | S IMRLD=+$P(IMR101,"^",11) D ^IMRRAD S:'IMRLD IMRLD="" ;LAST RADIOLOGY DATE NOTED
|
|---|
| 19 | S $P(IMR101,"^",11)=$S(IMRRAD>IMRLD:IMRRAD,1:IMRLD) K IMRLD ;check latest EXAM DATE against last radiology date noted
|
|---|
| 20 | DENT ; Get Dental Data
|
|---|
| 21 | S IMRLD=+$P(IMR101,"^",15) D DENT^IMRRAD S:'IMRLD IMRLD="" ;last dental appt date
|
|---|
| 22 | S $P(IMR101,"^",15)=$S(IMRDENT>IMRLD:IMRDENT,1:IMRLD) K IMRLD
|
|---|
| 23 | OP ; Get Outpatient Activity Data
|
|---|
| 24 | S IMRLD=+$P(IMR101,"^",16) D OP^IMRSCH S:'IMRLD IMRLD="" ;last OP date
|
|---|
| 25 | S $P(IMR101,"^",16)=$S(IMROP>IMRLD:IMROP,1:IMRLD) K IMRLD ;check latest scheduling date/time against last OP date
|
|---|
| 26 | WRAP S:'$D(^IMR(158.9,1,"NXT")) ^("NXT")=0 S IMRNXT2=+$P(^("NXT"),"^",2),IMRNXT1=+^("NXT")
|
|---|
| 27 | S:IMRT2="NEW"!(IMRNXT2<IMRFN) IMRNXT2=IMRFN ;IMRNXT2=last new case
|
|---|
| 28 | S ^IMR(158,IMRFN,101)=IMRDT_"^"_$P(IMR101,"^",2,99) ;IMRDT=LAST DATE DATA SURVEYED
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | MOVCDC0 ; Send nodes File 158 nodes if CDC form was generated.
|
|---|
| 32 | Q:'IMRSEND
|
|---|
| 33 | F IMRI=0,1,2,102,108:1:112 I $G(^IMR(158,IMRFN,IMRI))'="" S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="CDC"_IMRI_"^"_^IMR(158,IMRFN,IMRI) D
|
|---|
| 34 | .I IMRI=1 D
|
|---|
| 35 | ..S IMRNODE1=$G(^TMP($J,"IMRX",IMRC))
|
|---|
| 36 | ..S IMRSTATE=$P(IMRNODE1,U,13) ;state at onset of illness/aids
|
|---|
| 37 | ..I IMRSTATE'="" S IMRSTATE=$$GET1^DIQ(5,IMRSTATE,1,"E") ;state abbr
|
|---|
| 38 | ..S $P(IMRNODE1,U,13)=IMRSTATE
|
|---|
| 39 | ..S IMRSTATE=$P(IMRNODE1,U,18) ;state of hospital - aids dx
|
|---|
| 40 | ..I IMRSTATE'="" S IMRSTATE=$$GET1^DIQ(5,IMRSTATE,1,"E") ;state abbr
|
|---|
| 41 | ..S $P(IMRNODE1,U,18)=IMRSTATE
|
|---|
| 42 | ..S IMRSTATN=$P(IMRNODE1,U,8)
|
|---|
| 43 | ..I IMRSTATN'="" S IMRSTATN=$$GET1^DIQ(4,IMRSTATN,99,"I") ;station #
|
|---|
| 44 | ..S $P(IMRNODE1,U,8)=IMRSTATN
|
|---|
| 45 | ..S $P(IMRNODE1,U,2)="*1*"
|
|---|
| 46 | ..S ^TMP($J,"IMRX",IMRC)=IMRNODE1
|
|---|
| 47 | ..K IMRNODE1,IMRSTATE
|
|---|
| 48 | ..Q
|
|---|
| 49 | .Q
|
|---|
| 50 | Q
|
|---|
